?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
test-org-table: Tiny refactoring
[org-mode/org-tableheadings.git] / testing / lisp / test-org-table.el
blob4f994270a790138245ec64ed42c2565277d2093d
1 ;;; test-org-table.el --- tests for org-table.el
2
3 ;; Copyright (c) David Maus
4 ;; Authors: David Maus, Michael Brand
5
6 ;; This file is not part of GNU Emacs.
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21 ;;;; Comments:
22
23 ;; Template test file for Org tests. Many tests are also a howto
24 ;; example collection as a user documentation, more or less all those
25 ;; using `org-test-table-target-expect'. See also the doc string of
26 ;; `org-test-table-target-expect'.
27
28 ;;; Code:
29
30 (require 'org-table) ; `org-table-make-reference'
31
32 (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
33 "Simple sum without grouping rows, without title row."
34 (org-test-table-target-expect
35 "
36 | 2 |
37 | 4 |
38 | 8 |
39 | replace |
40 "
41 "
42 | 2 |
43 | 4 |
44 | 8 |
45 | 14 |
46 "
47 1
48 ;; Calc formula
49 "#+TBLFM: @>$1 = vsum(@<..@>>)"
50 ;; Lisp formula
51 "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
52
53 (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
54 "Simple sum without grouping rows, with title row."
55 (org-test-table-target-expect
56 "
57 | foo |
58 |---------|
59 | 2 |
60 | 4 |
61 | 8 |
62 | replace |
63 "
64 "
65 | foo |
66 |-----|
67 | 2 |
68 | 4 |
69 | 8 |
70 | 14 |
71 "
72 1
73 ;; Calc formula
74 "#+TBLFM: @>$1 = vsum(@I..@>>)"
75 ;; Lisp formula
76 "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
77
78 (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
79 "Simple sum with grouping rows, how not to do."
80 ;; The first example has a problem, see the second example in this
81 ;; ert-deftest.
82 (org-test-table-target-expect
83 "
84 | 2 |
85 | 4 |
86 | 8 |
87 |---------|
88 | replace |
89 "
90 "
91 | 2 |
92 | 4 |
93 | 8 |
94 |----|
95 | 14 |
96 "
97 1
98 ;; Calc formula
99 "#+TBLFM: $1 = vsum(@<..@>>)"
100 ;; Lisp formula
101 "#+TBLFM: $1 = '(+ @<..@>>); N")
102
103 ;; The problem is that the first three rows with the summands are
104 ;; considered the header and therefore column formulas are not
105 ;; applied on them as shown below. Also export behaves unexpected.
106 ;; See next ert-deftest how to group rows right.
107 (org-test-table-target-expect
108 "
109 | 2 | header |
110 | 4 | header |
111 | 8 | header |
112 |---------+---------|
113 | replace | replace |
114 "
115 "
116 | 2 | header |
117 | 4 | header |
118 | 8 | header |
119 |----+--------|
120 | 14 | 28 |
121 "
122 2
123 ;; Calc formula
124 "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
125 ;; Lisp formula
126 "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
127
128 (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
129 "Simple sum with grouping rows, how to do it right."
130 ;; Always add a top row with the column names separated by hline to
131 ;; get the desired header when you want to group rows.
132 (org-test-table-target-expect
133 "
134 | foo | bar |
135 |---------+---------|
136 | 2 | replace |
137 | 4 | replace |
138 | 8 | replace |
139 |---------+---------|
140 | replace | replace |
141 "
142 "
143 | foo | bar |
144 |-----+-----|
145 | 2 | 4 |
146 | 4 | 8 |
147 | 8 | 16 |
148 |-----+-----|
149 | 14 | 28 |
150 "
151 2
152 ;; Calc formula
153 "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
154 ;; Lisp formula
155 "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
156
157 (defconst references/target-normal "
158 | 0 | 1 | replace | replace | replace | replace | replace | replace |
159 | z | 1 | replace | replace | replace | replace | replace | replace |
160 | | 1 | replace | replace | replace | replace | replace | replace |
161 | | | replace | replace | replace | replace | replace | replace |
162 "
163 "Normal numbers and non-numbers for Lisp and Calc formula.")
164
165 (defconst references/target-special "
166 | nan | 1 | replace | replace | replace | replace | replace | replace |
167 | uinf | 1 | replace | replace | replace | replace | replace | replace |
168 | -inf | 1 | replace | replace | replace | replace | replace | replace |
169 | inf | 1 | replace | replace | replace | replace | replace | replace |
170 "
171 "Special numbers for Calc formula.")
172
173 (ert-deftest test-org-table/references/mode-string-EL ()
174 "Basic: Assign field reference, sum of field references, sum
175 and len of simple range reference (no row) and complex range
176 reference (with row). Mode string EL."
177 ;; Empty fields are kept during parsing field but lost as list
178 ;; elements within Lisp formula syntactically when used literally
179 ;; and not enclosed with " within fields, see last columns with len.
180 (org-test-table-target-expect
181 references/target-normal
182 ;; All the #ERROR show that for Lisp calculations N has to be used.
183 "
184 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
185 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
186 | | 1 | | 1 | 1 | 1 | 1 | 1 |
187 | | | | 0 | 0 | 0 | 0 | 0 |
188 "
189 1 (concat
190 "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
191 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
192 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
193
194 ;; Empty fields are kept during parsing field _and_ as list elements
195 ;; within Lisp formula syntactically even when used literally when
196 ;; enclosed with " within fields, see last columns with len.
197 (org-test-table-target-expect
198 "
199 | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
200 | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
201 | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
202 | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
203 "
204 "
205 | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
206 | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
207 | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
208 | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
209 "
210 1 (concat
211 "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
212 "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
213 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
214 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
215
216 (ert-deftest test-org-table/references/mode-string-E ()
217 "Basic: Assign field reference, sum of field references, sum
218 and len of simple range reference (no row) and complex range
219 reference (with row). Mode string E."
220 (let ((lisp
221 (concat
222 "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
223 "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
224 "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
225 (calc
226 (concat
227 "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
228 "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
229 "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
230 (org-test-table-target-expect
231 references/target-normal
232 ;; All the #ERROR show that for Lisp calculations N has to be used.
233 "
234 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
235 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
236 | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
237 | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
238 "
239 1 lisp)
240 (org-test-table-target-expect
241 references/target-normal
242 "
243 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
244 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
245 | | 1 | nan | nan | nan | nan | 2 | 2 |
246 | | | nan | nan | nan | nan | 2 | 2 |
247 "
248 1 calc)
249 (org-test-table-target-expect
250 references/target-special
251 "
252 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
253 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
254 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
255 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
256 "
257 1 calc)))
258
259 (ert-deftest test-org-table/references/mode-string-EN ()
260 "Basic: Assign field reference, sum of field references, sum
261 and len of simple range reference (no row) and complex range
262 reference (with row). Mode string EN."
263 (let ((lisp (concat
264 "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
265 "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
266 "$7 = '(length '($1..$2)); EN :: "
267 "$8 = '(length '(@0$1..@0$2)); EN"))
268 (calc (concat
269 "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
270 "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
271 "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
272 (org-test-table-target-expect
273 references/target-normal
274 "
275 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
276 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
277 | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
278 | | | 0 | 0 | 0 | 0 | 2 | 2 |
279 "
280 1 lisp calc)
281 (org-test-table-target-expect
282 references/target-special
283 "
284 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
285 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
286 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
287 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
288 "
289 1 calc)))
290
291 (ert-deftest test-org-table/references/mode-string-L ()
292 "Basic: Assign field reference, sum of field references, sum
293 and len of simple range reference (no row) and complex range
294 reference (with row). Mode string L."
295 (org-test-table-target-expect
296 references/target-normal
297 ;; All the #ERROR show that for Lisp calculations N has to be used.
298 "
299 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
300 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
301 | | 1 | | 1 | 1 | 1 | 1 | 1 |
302 | | | | 0 | 0 | 0 | 0 | 0 |
303 "
304 1 (concat
305 "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
306 "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
307 "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
308
309 (ert-deftest test-org-table/references/mode-string-none ()
310 "Basic: Assign field reference, sum of field references, sum
311 and len of simple range reference (no row) and complex range
312 reference (with row). No mode string."
313 (let ((lisp (concat
314 "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
315 "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
316 "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
317 (calc (concat
318 "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
319 "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
320 "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
321 (org-test-table-target-expect
322 references/target-normal
323 ;; All the #ERROR show that for Lisp calculations N has to be used.
324 "
325 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
326 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
327 | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
328 | | | | #ERROR | 0 | 0 | 0 | 0 |
329 "
330 1 lisp)
331 (org-test-table-target-expect
332 references/target-normal
333 "
334 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
335 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
336 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
337 | | | 0 | 0 | 0 | 0 | 0 | 0 |
338 "
339 1 calc)
340 (org-test-table-target-expect
341 references/target-special
342 "
343 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
344 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
345 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
346 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
347 "
348 1 calc)))
349
350 (ert-deftest test-org-table/references/mode-string-N ()
351 "Basic: Assign field reference, sum of field references, sum
352 and len of simple range reference (no row) and complex range
353 reference (with row). Mode string N."
354 (let ((lisp
355 (concat
356 "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
357 "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
358 "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
359 (calc
360 (concat
361 "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
362 "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
363 "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
364 (org-test-table-target-expect
365 references/target-normal
366 "
367 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
368 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
369 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
370 | | | 0 | 0 | 0 | 0 | 0 | 0 |
371 "
372 1 lisp calc)
373 (org-test-table-target-expect
374 references/target-special
375 "
376 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
377 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
378 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
379 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
380 "
381 1 calc)))
382
383 (ert-deftest test-org-table/lisp-return-value ()
384 "Basic: Return value of Lisp formulas."
385 (org-test-table-target-expect
386 "
387 | | nil | (list) | '() |
388 |-------------------------+-------------+--------+-----|
389 | type-of, no L | replace (r) | r | r |
390 | type-of identity, no L | r | r | r |
391 | identity, no L | r | r | r |
392 |-------------------------+-------------+--------+-----|
393 | type-of \"@1\" | r | r | r |
394 | type-of (identity \"@1\") | r | r | r |
395 | identity \"@1\" | r | r | r |
396 |-------------------------+-------------+--------+-----|
397 | type-of @1 | r | r | r |
398 | type-of (identity @1) | r | r | r |
399 | identity @1 | r | r | r |
400 "
401 "
402 | | nil | (list) | '() |
403 |-------------------------+--------+--------+--------|
404 | type-of, no L | string | string | string |
405 | type-of identity, no L | string | string | string |
406 | identity, no L | nil | (list) | '() |
407 |-------------------------+--------+--------+--------|
408 | type-of \"@1\" | string | string | string |
409 | type-of (identity \"@1\") | string | string | string |
410 | identity \"@1\" | nil | (list) | '() |
411 |-------------------------+--------+--------+--------|
412 | type-of @1 | symbol | symbol | symbol |
413 | type-of (identity @1) | symbol | symbol | symbol |
414 | identity @1 | nil | nil | nil |
415 "
416 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
417 "@3$<<..@3$> = '(type-of (identity @1)) :: "
418 "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
419
420 (ert-deftest test-org-table/compare ()
421 "Basic: Compare field references in Calc."
422 (org-test-table-target-expect
423 "
424 | | 0 | z | | nan | uinf | -inf | inf |
425 |------+------+------+------+------+------+------+------|
426 | 0 | repl | repl | repl | repl | repl | repl | repl |
427 | z | repl | repl | repl | repl | repl | repl | repl |
428 | | repl | repl | repl | repl | repl | repl | repl |
429 | nan | repl | repl | repl | repl | repl | repl | repl |
430 | uinf | repl | repl | repl | repl | repl | repl | repl |
431 | -inf | repl | repl | repl | repl | repl | repl | repl |
432 | inf | repl | repl | repl | repl | repl | repl | repl |
433 "
434 "
435 | | 0 | z | | nan | uinf | -inf | inf |
436 |------+---+---+---+-----+------+------+-----|
437 | 0 | x | | | | | | |
438 | z | | x | | | | | |
439 | | | | x | | | | |
440 | nan | | | | x | | | |
441 | uinf | | | | | x | | |
442 | -inf | | | | | | x | |
443 | inf | | | | | | | x |
444 "
445 1
446 ;; Compare field reference ($1) with field reference (@1)
447 "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
448 ;; Compare field reference ($1) with absolute term
449 (concat "#+TBLFM: "
450 "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
451 "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
452 "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
453 "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
454 "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
455 "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
456 "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
457
458 ;; Check field reference converted from an empty field: Despite this
459 ;; field reference will not end up in a result, Calc evaluates it.
460 ;; Make sure that also then there is no Calc error.
461 (org-test-table-target-expect
462 "
463 | 0 | replace |
464 | z | replace |
465 | | replace |
466 | nan | replace |
467 "
468 "
469 | 0 | 1 |
470 | z | z + 1 |
471 | | |
472 | nan | nan |
473 "
474 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
475
476 (ert-deftest test-org-table/empty-field ()
477 "Examples how to deal with empty fields."
478 ;; Test if one field is empty, else do a calculation
479 (org-test-table-target-expect
480 "
481 | -1 | replace |
482 | 0 | replace |
483 | | replace |
484 "
485 "
486 | -1 | 0 |
487 | 0 | 1 |
488 | | |
489 "
490 1
491 ;; Calc formula
492 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
493 ;; Lisp formula
494 "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
495
496 ;; Test if several fields are empty, else do a calculation
497 (org-test-table-target-expect
498 "
499 | 1 | 2 | replace |
500 | 4 | | replace |
501 | | 8 | replace |
502 | | | replace |
503 "
504 "
505 | 1 | 2 | 3 |
506 | 4 | | |
507 | | 8 | |
508 | | | |
509 "
510 1
511 ;; Calc formula
512 (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
513 "string(\"\"), $1 + $2); E")
514 ;; Lisp formula
515 (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
516 "\"\" (+ $1 $2)); L"))
517
518 ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
519 (org-test-table-target-expect
520 "
521 | 1.5 | 0 |
522 | 3.5 | |
523 | | 5 |
524 | | |
525 "
526 "
527 | 1.5 | 2.0 |
528 | 3.5 | 4.0 |
529 | | 5.0 |
530 | | |
531 "
532 1
533 ;; Calc formula
534 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
535 "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
536 ;; Lisp formula not implemented yet
537 )
538
539 ;; Empty fields in simple and complex range reference
540 (org-test-table-target-expect
541 "
542 | | | | | repl | repl | repl | repl | repl | repl |
543 | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
544 | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
545 "
546 "
547 | | | | | | | | | 0 | 0 |
548 | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
549 | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
550 "
551 1
552 ;; Calc formula
553 (concat
554 "#+TBLFM: "
555 "$5 = if(typeof(vmean($1..$4)) == 12, "
556 "string(\"\"), vmean($1..$4)); E :: "
557 "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
558 "string(\"\"), vmean(@0$1..@0$4)); E :: "
559 "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
560 "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
561 "$9 = vmean($1..$4); EN :: "
562 "$10 = vmean(@0$1..@0$4); EN")
563 ;; Lisp formula
564 (concat
565 "#+TBLFM: "
566 "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
567 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
568 "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
569 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
570 "$7 = '(let ((l '($1..$4))) "
571 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
572 "$8 = '(let ((l '(@0$1..@0$4))) "
573 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
574 "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
575 "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")
576 ))
577
578 (ert-deftest test-org-table/copy-field ()
579 "Experiments on how to copy one field into another field.
580 See also `test-org-table/remote-reference-access'."
581 (let ((target "
582 | 0 | replace |
583 | a b | replace |
584 | c d | replace |
585 | | replace |
586 | 2012-12 | replace |
587 | [2012-12-31 Mon] | replace |
588 "))
589 ;; Lisp formula to copy literally
590 (org-test-table-target-expect
591 target
592 "
593 | 0 | 0 |
594 | a b | a b |
595 | c d | c d |
596 | | |
597 | 2012-12 | 2012-12 |
598 | [2012-12-31 Mon] | [2012-12-31 Mon] |
599 "
600 1 "#+TBLFM: $2 = '(identity $1)")
601
602 ;; Calc formula to copy quite literally
603 (org-test-table-target-expect
604 target
605 "
606 | 0 | 0 |
607 | a b | a b |
608 | c d | c d |
609 | | |
610 | 2012-12 | 2012-12 |
611 | [2012-12-31 Mon] | [2012-12-31 Mon] |
612 "
613 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
614 "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
615
616 ;; Calc formula simple
617 (org-test-table-target-expect
618 target
619 "
620 | 0 | 0 |
621 | a b | a b |
622 | c d | c d |
623 | | |
624 | 2012-12 | 2000 |
625 | [2012-12-31 Mon] | [2012-12-31 Mon] |
626 "
627 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
628
629 (ert-deftest test-org-table/sub-total ()
630 "Grouped rows with sub-total.
631 Begin range with \"@II\" to handle multiline header. Convert
632 integer to float with \"+.0\" for sub-total of items c1 and c2.
633 Sum empty fields as value zero but without ignoring them for
634 \"vlen\" with format specifier \"EN\". Format possibly empty
635 results with the Calc formatter \"f-1\" instead of the printf
636 formatter \"%.1f\"."
637 (org-test-table-target-expect
638 "
639 |-------+---------+---------|
640 | Item | Item | Sub- |
641 | name | value | total |
642 |-------+---------+---------|
643 | a1 | 4.1 | replace |
644 | a2 | 8.2 | replace |
645 | a3 | | replace |
646 |-------+---------+---------|
647 | b1 | 16.0 | replace |
648 |-------+---------+---------|
649 | c1 | 32 | replace |
650 | c2 | 64 | replace |
651 |-------+---------+---------|
652 | Total | replace | replace |
653 |-------+---------+---------|
654 "
655 "
656 |-------+-------+-------|
657 | Item | Item | Sub- |
658 | name | value | total |
659 |-------+-------+-------|
660 | a1 | 4.1 | |
661 | a2 | 8.2 | |
662 | a3 | | 12.3 |
663 |-------+-------+-------|
664 | b1 | 16.0 | 16.0 |
665 |-------+-------+-------|
666 | c1 | 32 | |
667 | c2 | 64 | 96.0 |
668 |-------+-------+-------|
669 | Total | 124.3 | |
670 |-------+-------+-------|
671 "
672 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
673 "$3 = if(vlen(@0..@+I) == 1, "
674 "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
675 "@>$3 = string(\"\")")))
676
677 (ert-deftest test-org-table/org-lookup-all ()
678 "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
679 See also http://orgmode.org/worg/org-tutorials/org-lookups.html ."
680 (let ((data "
681 #+NAME: data
682 | Purchase | Product | Shop | Rating |
683 |----------+---------+------+--------|
684 | a | p1 | s1 | 1 |
685 | b | p1 | s2 | 4 |
686 | c | p2 | s1 | 2 |
687 | d | p3 | s2 | 8 |
688 "))
689
690 ;; Product rating and ranking by average purchase from "#+NAME: data"
691 (org-test-table-target-expect
692 (concat data "
693 | Product | Rating | Ranking |
694 |---------+---------+---------|
695 | p1 | replace | replace |
696 | p2 | replace | replace |
697 | p3 | replace | replace |
698 ")
699 (concat data "
700 | Product | Rating | Ranking |
701 |---------+--------+---------|
702 | p1 | 2.5 | 2 |
703 | p2 | 2.0 | 3 |
704 | p3 | 8.0 | 1 |
705 ")
706 2 (concat
707 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
708 "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
709 "(/ (apply '+ all) (length all) 1.0)); L :: "
710 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
711
712 ;; Shop rating and ranking by average purchase from "#+NAME: data"
713 (org-test-table-target-expect
714 (concat data "
715 | Shop | Rating | Ranking |
716 |------+---------+---------|
717 | s1 | replace | replace |
718 | s2 | replace | replace |
719 ")
720 (concat data "
721 | Shop | Rating | Ranking |
722 |------+--------+---------|
723 | s1 | 1.5 | 2 |
724 | s2 | 6.0 | 1 |
725 ")
726 2 (concat
727 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
728 "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
729 "(/ (apply '+ all) (length all) 1.0)); L :: "
730 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
731
732 (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
733 ;; For Lisp formula only
734 (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
735 (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
736 (should (equal "" (org-table-make-reference "" t nil 'literal)))
737 (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
738 (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
739 (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
740 (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
741
742 (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
743 ;; For Lisp formula
744 (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
745 (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
746 (should (equal"\"\"" (org-table-make-reference "" t nil t)))
747 (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
748 (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
749 (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
750 (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
751 ;; For Calc formula
752 (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
753 (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
754 (should (equal "nan" (org-table-make-reference "" t nil nil)))
755 (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
756 (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
757 (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
758 (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
759 ;; For Calc formula, special numbers
760 (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
761 (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
762 (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
763 (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
764 (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
765 (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
766 (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
767 (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
768
769 (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
770 ;; For Lisp formula
771 (should (equal "0" (org-table-make-reference "0" t t t)))
772 (should (equal "0" (org-table-make-reference "z" t t t)))
773 (should (equal "0" (org-table-make-reference "" t t t)))
774 (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
775 (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
776 (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
777 (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
778 ;; For Calc formula
779 (should (equal "(0)" (org-table-make-reference "0" t t nil)))
780 (should (equal "(0)" (org-table-make-reference "z" t t nil)))
781 (should (equal "(0)" (org-table-make-reference "" t t nil)))
782 (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
783 (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
784 (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
785 (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
786 ;; For Calc formula, special numbers
787 (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
788 (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
789 (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
790 (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
791 (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
792 (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
793 (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
794 (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
795
796 (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
797 ;; For Lisp formula only
798 (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
799 (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
800 (should (equal "" (org-table-make-reference "" nil nil 'literal)))
801 (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
802 (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
803 (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
804 (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
805
806 (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
807 ;; For Lisp formula
808 (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
809 (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
810 (should (equal "" (org-table-make-reference "" nil nil t)))
811 (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
812 (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
813 (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
814 (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
815 ;; For Calc formula
816 (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
817 (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
818 (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
819 (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
820 (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
821 (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
822 (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
823 ;; For Calc formula, special numbers
824 (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
825 (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
826 (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
827 (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
828 (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
829 (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
830 (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
831 (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
832
833 (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
834 ;; For Lisp formula
835 (should (equal "0" (org-table-make-reference "0" nil t t)))
836 (should (equal "0" (org-table-make-reference "z" nil t t)))
837 (should (equal "" (org-table-make-reference "" nil t t)))
838 (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
839 (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
840 (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
841 (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
842 ;; For Calc formula
843 (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
844 (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
845 (should (equal "(0)" (org-table-make-reference "" nil t nil)))
846 (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
847 (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
848 (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
849 (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
850 ;; For Calc formula, special numbers
851 (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
852 (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
853 (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
854 (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
855 (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
856 (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
857 (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
858 (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
859
860 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
861 "Simple reference @2$1."
862 (should
863 (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
864
865 ;; TODO: Test broken
866 ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
867 ;; "Self reference @1$1."
868 ;; (should
869 ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
870
871 (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
872 "Remote reference."
873 (should
874 (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
875
876 (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
877 "Simple reference @2$1."
878 (should
879 (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
880
881 (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
882 "Self reference $0."
883 (should
884 (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
885
886 ;; TODO: Test Broken
887 ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
888 ;; "Remote reference."
889 ;; (should
890 ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
891
892 (ert-deftest test-org-table/remote-reference-access ()
893 "Access to remote reference.
894 See also `test-org-table/copy-field'."
895 (org-test-table-target-expect
896 "
897 #+NAME: table
898 | | x 42 | |
899
900 | replace | replace |
901 "
902 "
903 #+NAME: table
904 | | x 42 | |
905
906 | x 42 | 84 x |
907 "
908 1 (concat "#+TBLFM: "
909 ;; Copy text without calculation: Use Lisp formula
910 "$1 = '(identity remote(table, @1$2)) :: "
911 ;; Do a calculation: Use Calc (or Lisp ) formula
912 "$2 = 2 * remote(table, @1$2)")))
913
914 (ert-deftest test-org-table/remote-reference-indirect ()
915 "Access to remote reference with indirection of name or ID."
916 (let ((source-tables "
917 #+NAME: 2012
918 | amount |
919 |--------|
920 | 1 |
921 | 2 |
922 |--------|
923 | 3 |
924 #+TBLFM: @>$1 = vsum(@I..@II)
925
926 #+NAME: 2013
927 | amount |
928 |--------|
929 | 4 |
930 | 8 |
931 |--------|
932 | 12 |
933 #+TBLFM: @>$1 = vsum(@I..@II)
934 "))
935
936 ;; Read several remote references from same column
937 (org-test-table-target-expect
938 (concat source-tables "
939 #+NAME: summary
940 | year | amount |
941 |-------+---------|
942 | 2012 | replace |
943 | 2013 | replace |
944 |-------+---------|
945 | total | replace |
946 ")
947 (concat source-tables "
948 #+NAME: summary
949 | year | amount |
950 |-------+--------|
951 | 2012 | 3 |
952 | 2013 | 12 |
953 |-------+--------|
954 | total | 15 |
955 ")
956 1
957 ;; Calc formula
958 "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
959 ;; Lisp formula
960 (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
961 "@>$2 = '(+ @I..@II); N"))
962
963 ;; Read several remote references from same row
964 (org-test-table-target-expect
965 (concat source-tables "
966 #+NAME: summary
967 | year | 2012 | 2013 | total |
968 |--------+---------+---------+---------|
969 | amount | replace | replace | replace |
970 ")
971 (concat source-tables "
972 #+NAME: summary
973 | year | 2012 | 2013 | total |
974 |--------+------+------+-------|
975 | amount | 3 | 12 | 15 |
976 ")
977 1
978 ;; Calc formula
979 "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
980 ;; Lisp formula
981 (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
982 "@2$> = '(+ $<<..$>>); N"))))
983
984 (ert-deftest test-org-table/org-at-TBLFM-p ()
985 (org-test-with-temp-text-in-file
986 "
987 | 1 |
988 | 2 |
989 #+TBLFM: $2=$1*2
990
991 "
992 (goto-char (point-min))
993 (forward-line 2)
994 (should (equal (org-at-TBLFM-p) nil))
995
996 (goto-char (point-min))
997 (forward-line 3)
998 (should (equal (org-at-TBLFM-p) t))
999
1000 (goto-char (point-min))
1001 (forward-line 4)
1002 (should (equal (org-at-TBLFM-p) nil))))
1003
1004 (ert-deftest test-org-table/org-table-TBLFM-begin ()
1005 (org-test-with-temp-text-in-file
1006 "
1007 | 1 |
1008 | 2 |
1009 #+TBLFM: $2=$1*2
1010
1011 "
1012 (goto-char (point-min))
1013 (should (equal (org-table-TBLFM-begin)
1014 nil))
1015
1016 (goto-char (point-min))
1017 (forward-line 1)
1018 (should (equal (org-table-TBLFM-begin)
1019 nil))
1020
1021 (goto-char (point-min))
1022 (forward-line 3)
1023 (should (= (org-table-TBLFM-begin)
1024 14))
1025
1026 (goto-char (point-min))
1027 (forward-line 4)
1028 (should (= (org-table-TBLFM-begin)
1029 14))
1030
1031 ))
1032
1033 (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
1034 "For multiple #+TBLFM lines."
1035 (org-test-with-temp-text-in-file
1036 "
1037 | 1 |
1038 | 2 |
1039 #+TBLFM: $2=$1*1
1040 #+TBLFM: $2=$1*2
1041
1042 "
1043 (goto-char (point-min))
1044 (should (equal (org-table-TBLFM-begin)
1045 nil))
1046
1047 (goto-char (point-min))
1048 (forward-line 1)
1049 (should (equal (org-table-TBLFM-begin)
1050 nil))
1051
1052 (goto-char (point-min))
1053 (forward-line 3)
1054 (should (= (org-table-TBLFM-begin)
1055 14))
1056
1057 (goto-char (point-min))
1058 (forward-line 4)
1059 (should (= (org-table-TBLFM-begin)
1060 14))
1061
1062 (goto-char (point-min))
1063 (forward-line 5)
1064 (should (= (org-table-TBLFM-begin)
1065 14))
1066
1067 ))
1068
1069 (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
1070 (org-test-with-temp-text-in-file
1071 "
1072 | 1 |
1073 | 2 |
1074 #+TBLFM: $2=$1*1
1075 #+TBLFM: $2=$1*2
1076
1077 | 6 |
1078 | 7 |
1079 #+TBLFM: $2=$1*1
1080 #+TBLFM: $2=$1*2
1081
1082 "
1083 (goto-char (point-min))
1084 (should (equal (org-table-TBLFM-begin)
1085 nil))
1086
1087 (goto-char (point-min))
1088 (forward-line 1)
1089 (should (equal (org-table-TBLFM-begin)
1090 nil))
1091
1092 (goto-char (point-min))
1093 (forward-line 3)
1094 (should (= (org-table-TBLFM-begin)
1095 14))
1096
1097 (goto-char (point-min))
1098 (forward-line 4)
1099 (should (= (org-table-TBLFM-begin)
1100 14))
1101
1102 (goto-char (point-min))
1103 (forward-line 5)
1104 (should (= (org-table-TBLFM-begin)
1105 14))
1106
1107 (goto-char (point-min))
1108 (forward-line 6)
1109 (should (= (org-table-TBLFM-begin)
1110 14))
1111
1112 (goto-char (point-min))
1113 (forward-line 8)
1114 (should (= (org-table-TBLFM-begin)
1115 61))
1116
1117 (goto-char (point-min))
1118 (forward-line 9)
1119 (should (= (org-table-TBLFM-begin)
1120 61))
1121
1122 (goto-char (point-min))
1123 (forward-line 10)
1124 (should (= (org-table-TBLFM-begin)
1125 61))))
1126
1127 (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
1128 (org-test-with-temp-text-in-file
1129 "
1130 | 1 | |
1131 | 2 | |
1132 #+TBLFM: $2=$1*1
1133 #+TBLFM: $2=$1*2
1134 #+TBLFM: $2=$1*3
1135 "
1136 (let ((got (progn (goto-char (point-min))
1137 (forward-line 3)
1138 (org-table-calc-current-TBLFM)
1139 (buffer-string)))
1140 (expect "
1141 | 1 | 1 |
1142 | 2 | 2 |
1143 #+TBLFM: $2=$1*1
1144 #+TBLFM: $2=$1*2
1145 #+TBLFM: $2=$1*3
1146 "))
1147 (should (string= got
1148 expect)))
1149
1150 (let ((got (progn (goto-char (point-min))
1151 (forward-line 4)
1152 (org-table-calc-current-TBLFM)
1153 (buffer-string)))
1154 (expect "
1155 | 1 | 2 |
1156 | 2 | 4 |
1157 #+TBLFM: $2=$1*1
1158 #+TBLFM: $2=$1*2
1159 #+TBLFM: $2=$1*3
1160 "))
1161 (should (string= got
1162 expect)))))
1163
1164 (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
1165 "org-table-calc-current-TBLFM should preserve the input as it was."
1166 (org-test-with-temp-text-in-file
1167 "
1168 | 1 | 1 |
1169 | 2 | 2 |
1170 #+TBLFM: $2=$1*1
1171 #+TBLFM: $2=$1*2::$2=$1*2
1172 #+TBLFM: $2=$1*3
1173 "
1174 (let ((expect "
1175 | 1 | 1 |
1176 | 2 | 2 |
1177 #+TBLFM: $2=$1*1
1178 #+TBLFM: $2=$1*2::$2=$1*2
1179 #+TBLFM: $2=$1*3
1180 "))
1181 (goto-char (point-min))
1182 (forward-line 4)
1183 (should-error (org-table-calc-current-TBLFM))
1184 (setq got (buffer-string))
1185 (message "%s" got)
1186 (should (string= got
1187 expect)))))
1188
1189 ;;; Radio Tables
1190
1191 (ert-deftest test-org-table/to-generic ()
1192 "Test `orgtbl-to-generic' specifications."
1193 ;; Test :hline parameter.
1194 (should
1195 (equal "a\nb"
1196 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1197 '(:hline nil))))
1198 (should
1199 (equal "a\n~\nb"
1200 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1201 '(:hline "~"))))
1202 ;; Test :sep parameter.
1203 (should
1204 (equal "a!b\nc!d"
1205 (orgtbl-to-generic
1206 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1207 '(:sep "!"))))
1208 ;; Test :hsep parameter.
1209 (should
1210 (equal "a!b\nc?d"
1211 (orgtbl-to-generic
1212 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1213 '(:sep "?" :hsep "!"))))
1214 ;; Test :tstart parameter.
1215 (should
1216 (equal "<begin>\na"
1217 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
1218 (should
1219 (equal "<begin>\na"
1220 (orgtbl-to-generic (org-table-to-lisp "| a |")
1221 '(:tstart (lambda () "<begin>")))))
1222 (should
1223 (equal "a"
1224 (orgtbl-to-generic (org-table-to-lisp "| a |")
1225 '(:tstart "<begin>" :splice t))))
1226 ;; Test :tend parameter.
1227 (should
1228 (equal "a\n<end>"
1229 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
1230 (should
1231 (equal "a\n<end>"
1232 (orgtbl-to-generic (org-table-to-lisp "| a |")
1233 '(:tend (lambda () "<end>")))))
1234 (should
1235 (equal "a"
1236 (orgtbl-to-generic (org-table-to-lisp "| a |")
1237 '(:tend "<end>" :splice t))))
1238 ;; Test :lstart parameter.
1239 (should
1240 (equal "> a"
1241 (orgtbl-to-generic
1242 (org-table-to-lisp "| a |") '(:lstart "> "))))
1243 (should
1244 (equal "> a"
1245 (orgtbl-to-generic (org-table-to-lisp "| a |")
1246 '(:lstart (lambda () "> ")))))
1247 ;; Test :llstart parameter.
1248 (should
1249 (equal "> a\n>> b"
1250 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1251 '(:lstart "> " :llstart ">> "))))
1252 ;; Test :hlstart parameter.
1253 (should
1254 (equal "!> a\n> b"
1255 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1256 '(:lstart "> " :hlstart "!> "))))
1257 ;; Test :hllstart parameter.
1258 (should
1259 (equal "!> a\n!!> b\n> c"
1260 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1261 '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
1262 ;; Test :lend parameter.
1263 (should
1264 (equal "a <"
1265 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
1266 ;; Test :llend parameter.
1267 (should
1268 (equal "a <\nb <<"
1269 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1270 '(:lend " <" :llend " <<"))))
1271 ;; Test :hlend parameter.
1272 (should
1273 (equal "a <!\nb <"
1274 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1275 '(:lend " <" :hlend " <!"))))
1276 ;; Test :hllend parameter.
1277 (should
1278 (equal "a <!\nb <!!\nc <"
1279 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1280 '(:lend " <" :hlend " <!" :hllend " <!!"))))
1281 ;; Test :lfmt parameter.
1282 (should
1283 (equal "a!b"
1284 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1285 '(:lfmt "%s!%s"))))
1286 (should
1287 (equal "a+b"
1288 (orgtbl-to-generic
1289 (org-table-to-lisp "| a | b |")
1290 '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1291 (should
1292 (equal "a!b"
1293 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1294 '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1295 ;; Test :llfmt parameter.
1296 (should
1297 (equal "a!b"
1298 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1299 '(:llfmt "%s!%s"))))
1300 (should
1301 (equal "a!b\nc+d"
1302 (orgtbl-to-generic
1303 (org-table-to-lisp "| a | b |\n| c | d |")
1304 '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1305 (should
1306 (equal "a!b"
1307 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1308 '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1309 ;; Test :hlfmt parameter.
1310 (should
1311 (equal "a!b\ncd"
1312 (orgtbl-to-generic
1313 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1314 '(:hlfmt "%s!%s"))))
1315 (should
1316 (equal "a+b\ncd"
1317 (orgtbl-to-generic
1318 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1319 '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1320 (should
1321 (equal "a!b\n>c d<"
1322 (orgtbl-to-generic
1323 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1324 '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1325 ;; Test :hllfmt parameter.
1326 (should
1327 (equal "a!b\ncd"
1328 (orgtbl-to-generic
1329 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1330 '(:hllfmt "%s!%s"))))
1331 (should
1332 (equal "a+b\ncd"
1333 (orgtbl-to-generic
1334 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1335 '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1336 (should
1337 (equal "a!b\n>c d<"
1338 (orgtbl-to-generic
1339 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1340 '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1341 ;; Test :fmt parameter.
1342 (should
1343 (equal ">a<\n>b<"
1344 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1345 '(:fmt ">%s<"))))
1346 (should
1347 (equal ">a<b"
1348 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1349 '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
1350 (should
1351 (equal "a b"
1352 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1353 '(:fmt (2 " %s")))))
1354 (should
1355 (equal ">a<"
1356 (orgtbl-to-generic (org-table-to-lisp "| a |")
1357 '(:fmt (lambda (c) (format ">%s<" c))))))
1358 ;; Test :hfmt parameter.
1359 (should
1360 (equal ">a<\nb"
1361 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1362 '(:hfmt ">%s<"))))
1363 (should
1364 (equal ">a<b\ncd"
1365 (orgtbl-to-generic
1366 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1367 '(:hfmt (1 ">%s<" 2 identity)))))
1368 (should
1369 (equal "a b\ncd"
1370 (orgtbl-to-generic
1371 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1372 '(:hfmt (2 " %s")))))
1373 (should
1374 (equal ">a<\nb"
1375 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1376 '(:hfmt (lambda (c) (format ">%s<" c))))))
1377 ;; Test :efmt parameter.
1378 (should
1379 (equal "2x10^3"
1380 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1381 '(:efmt "%sx10^%s"))))
1382 (should
1383 (equal "2x10^3"
1384 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1385 '(:efmt (lambda (m e) (concat m "x10^" e))))))
1386 (should
1387 (equal "2x10^3"
1388 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1389 '(:efmt (1 "%sx10^%s")))))
1390 (should
1391 (equal "2x10^3"
1392 (orgtbl-to-generic
1393 (org-table-to-lisp "| 2e3 |")
1394 '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
1395 (should
1396 (equal "2e3"
1397 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
1398 ;; Test :skip parameter.
1399 (should
1400 (equal "cd"
1401 (orgtbl-to-generic
1402 (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
1403 '(:skip 2))))
1404 ;; Test :skipcols parameter.
1405 (should
1406 (equal "a\nc"
1407 (orgtbl-to-generic
1408 (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
1409 (should
1410 (equal "a\nc"
1411 (orgtbl-to-generic
1412 (org-table-to-lisp
1413 "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
1414 '(:skipcols (2)))))
1415 ;; Test :raw parameter.
1416 (when (featurep 'ox-latex)
1417 (should
1418 (string-match-p
1419 "/a/"
1420 (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
1421 '(:backend latex :raw t)))))
1422 ;; Hooks are ignored.
1423 (should
1424 (equal
1425 "a\nb"
1426 (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
1427 (org-export-before-parsing-hook fun-list)
1428 (org-export-before-processing-hook fun-list))
1429 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1430 '(:hline nil)))))
1431 ;; User-defined export filters are ignored.
1432 (should
1433 (equal
1434 "a\nb"
1435 (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
1436 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1437 '(:hline nil)))))
1438 ;; Macros, even if unknown, are returned as-is.
1439 (should
1440 (equal "{{{macro}}}"
1441 (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
1442
1443 (ert-deftest test-org-table/to-latex ()
1444 "Test `orgtbl-to-latex' specifications."
1445 (should
1446 (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
1447 (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
1448 ;; Test :environment parameter.
1449 (should
1450 (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
1451 (orgtbl-to-latex (org-table-to-lisp "| a |")
1452 '(:environment "tabularx"))))
1453 ;; Test :booktabs parameter.
1454 (should
1455 (string-match-p
1456 "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
1457 ;; Handle LaTeX snippets.
1458 (should
1459 (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
1460 (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
1461 ;; Test pseudo objects and :raw parameter.
1462 (should
1463 (string-match-p
1464 "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
1465
1466 (ert-deftest test-org-table/to-html ()
1467 "Test `orgtbl-to-html' specifications."
1468 (should
1469 (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
1470 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
1471
1472
1473 <colgroup>
1474 <col class=\"org-left\" />
1475 </colgroup>
1476 <tbody>
1477 <tr>
1478 <td class=\"org-left\">a</td>
1479 </tr>
1480 </tbody>
1481 </table>"))
1482 ;; Test :attributes parameter.
1483 (should
1484 (string-match-p
1485 "<table>"
1486 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
1487 (should
1488 (string-match-p
1489 "<table border=\"2\">"
1490 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
1491
1492 (ert-deftest test-org-table/to-texinfo ()
1493 "Test `orgtbl-to-texinfo' specifications."
1494 (should
1495 (equal "@multitable {a}\n@item a\n@end multitable"
1496 (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
1497 ;; Test :columns parameter.
1498 (should
1499 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1500 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1501 '(:columns ".4 .6"))))
1502 (should
1503 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1504 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1505 '(:columns "@columnfractions .4 .6"))))
1506 (should
1507 (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
1508 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1509 '(:columns "{xxx} {xx}")))))
1510
1511 (ert-deftest test-org-table/to-orgtbl ()
1512 "Test `orgtbl-to-orgtbl' specifications."
1513 (should
1514 (equal "| a | b |\n|---+---|\n| c | d |"
1515 (orgtbl-to-orgtbl
1516 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
1517
1518 (ert-deftest test-org-table/to-unicode ()
1519 "Test `orgtbl-to-unicode' specifications."
1520 (should
1521 (equal "━━━\n a \n━━━"
1522 (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
1523 ;; Test :narrow parameter.
1524 (should
1525 (equal "━━━━\n => \n━━━━"
1526 (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
1527 '(:narrow t)))))
1528
1529 (ert-deftest test-org-table/send-region ()
1530 "Test `orgtbl-send-table' specifications."
1531 ;; Error when not at a table.
1532 (should-error
1533 (org-test-with-temp-text "Paragraph"
1534 (orgtbl-send-table)))
1535 ;; Error when destination is missing.
1536 (should-error
1537 (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
1538 (orgtbl-send-table)))
1539 ;; Error when transformation function is not specified.
1540 (should-error
1541 (org-test-with-temp-text "
1542 # BEGIN RECEIVE ORGTBL table
1543 # END RECEIVE ORGTBL table
1544 #+ORGTBL: SEND table
1545 <point>| a |"
1546 (orgtbl-send-table)))
1547 ;; Standard test.
1548 (should
1549 (equal "| a |\n|---|\n| b |\n"
1550 (org-test-with-temp-text "
1551 # BEGIN RECEIVE ORGTBL table
1552 # END RECEIVE ORGTBL table
1553 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1554 <point>| a |\n|---|\n| b |"
1555 (orgtbl-send-table)
1556 (goto-char (point-min))
1557 (buffer-substring-no-properties
1558 (search-forward "# BEGIN RECEIVE ORGTBL table\n")
1559 (progn (search-forward "# END RECEIVE ORGTBL table")
1560 (match-beginning 0))))))
1561 ;; Allow multiple receiver locations.
1562 (should
1563 (org-test-with-temp-text "
1564 # BEGIN RECEIVE ORGTBL table
1565 # END RECEIVE ORGTBL table
1566
1567 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1568 <point>| a |
1569
1570 # BEGIN RECEIVE ORGTBL table
1571 # END RECEIVE ORGTBL table"
1572 (orgtbl-send-table)
1573 (goto-char (point-min))
1574 (search-forward "| a |" nil t 3))))
1575
1576 \f
1577 ;;; Align
1578
1579 (ert-deftest test-org-table/align ()
1580 "Test `org-table-align' specifications."
1581 ;; Regular test.
1582 (should
1583 (equal "| a |\n"
1584 (org-test-with-temp-text "| a |"
1585 (org-table-align)
1586 (buffer-string))))
1587 ;; Preserve alignment.
1588 (should
1589 (equal " | a |\n"
1590 (org-test-with-temp-text " | a |"
1591 (org-table-align)
1592 (buffer-string))))
1593 ;; Handle horizontal lines.
1594 (should
1595 (equal "| 123 |\n|-----|\n"
1596 (org-test-with-temp-text "| 123 |\n|-|"
1597 (org-table-align)
1598 (buffer-string))))
1599 (should
1600 (equal "| a | b |\n|---+---|\n"
1601 (org-test-with-temp-text "| a | b |\n|-+-|"
1602 (org-table-align)
1603 (buffer-string))))
1604 ;; Handle empty fields.
1605 (should
1606 (equal "| a | bc |\n| bcd | |\n"
1607 (org-test-with-temp-text "| a | bc |\n| bcd | |"
1608 (org-table-align)
1609 (buffer-string))))
1610 (should
1611 (equal "| abc | bc |\n| | bcd |\n"
1612 (org-test-with-temp-text "| abc | bc |\n| | bcd |"
1613 (org-table-align)
1614 (buffer-string))))
1615 ;; Handle missing fields.
1616 (should
1617 (equal "| a | b |\n| c | |\n"
1618 (org-test-with-temp-text "| a | b |\n| c |"
1619 (org-table-align)
1620 (buffer-string))))
1621 (should
1622 (equal "| a | b |\n|---+---|\n"
1623 (org-test-with-temp-text "| a | b |\n|---|"
1624 (org-table-align)
1625 (buffer-string))))
1626 ;; Alignment is done to the right when the ratio of numbers in the
1627 ;; column is superior to `org-table-number-fraction'.
1628 (should
1629 (equal "| 1 |\n| 12 |\n| abc |"
1630 (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
1631 (let ((org-table-number-fraction 0.5)) (org-table-align))
1632 (buffer-string))))
1633 (should
1634 (equal "| 1 |\n| ab |\n| abc |"
1635 (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
1636 (let ((org-table-number-fraction 0.5)) (org-table-align))
1637 (buffer-string))))
1638 ;; Obey to alignment cookies.
1639 (should
1640 (equal "| <r> |\n| ab |\n| abc |"
1641 (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
1642 (let ((org-table-number-fraction 0.5)) (org-table-align))
1643 (buffer-string))))
1644 (should
1645 (equal "| <l> |\n| 12 |\n| 123 |"
1646 (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
1647 (let ((org-table-number-fraction 0.5)) (org-table-align))
1648 (buffer-string))))
1649 (should
1650 (equal "| <c> |\n| 1 |\n| 123 |"
1651 (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
1652 (let ((org-table-number-fraction 0.5)) (org-table-align))
1653 (buffer-string)))))
1654
1655 (ert-deftest test-org-table/align-buffer-tables ()
1656 "Align all tables when updating buffer."
1657 (let ((before "
1658 | a b |
1659
1660 | c d |
1661 ")
1662 (after "
1663 | a b |
1664
1665 | c d |
1666 "))
1667 (should (equal (org-test-with-temp-text before
1668 (org-table-recalculate-buffer-tables)
1669 (buffer-string))
1670 after))
1671 (should (equal (org-test-with-temp-text before
1672 (org-table-iterate-buffer-tables)
1673 (buffer-string))
1674 after))))
1675
1676 \f
1677 ;;; Sorting
1678
1679 (ert-deftest test-org-table/sort-lines ()
1680 "Test `org-table-sort-lines' specifications."
1681 ;; Sort numerically.
1682 (should
1683 (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
1684 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1685 (org-table-sort-lines nil ?n)
1686 (buffer-string))))
1687 (should
1688 (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
1689 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1690 (org-table-sort-lines nil ?N)
1691 (buffer-string))))
1692 ;; Sort alphabetically.
1693 (should
1694 (equal "| a | x |\n| b | 4 |\n| c | 3 |\n"
1695 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1696 (org-table-sort-lines nil ?a)
1697 (buffer-string))))
1698 (should
1699 (equal "| c | 3 |\n| b | 4 |\n| a | x |\n"
1700 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1701 (org-table-sort-lines nil ?A)
1702 (buffer-string))))
1703 ;; Sort alphabetically with case.
1704 (should
1705 (equal "| C |\n| a |\n| b |\n"
1706 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1707 (org-table-sort-lines t ?a)
1708 (buffer-string))))
1709 (should
1710 (equal "| b |\n| a |\n| C |\n"
1711 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1712 (org-table-sort-lines nil ?A)
1713 (buffer-string))))
1714 ;; Sort by time (timestamps)
1715 (should
1716 (equal
1717 "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
1718 (org-test-with-temp-text
1719 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1720 (org-table-sort-lines nil ?t)
1721 (buffer-string))))
1722 (should
1723 (equal
1724 "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
1725 (org-test-with-temp-text
1726 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1727 (org-table-sort-lines nil ?T)
1728 (buffer-string))))
1729 ;; Sort by time (HH:MM values)
1730 (should
1731 (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
1732 (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1733 (org-table-sort-lines nil ?t)
1734 (buffer-string))))
1735 (should
1736 (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1737 (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1738 (org-table-sort-lines nil ?T)
1739 (buffer-string))))
1740 ;; Sort by time (durations)
1741 (should
1742 (equal "| 1d 3:00 |\n| 28:00 |\n"
1743 (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
1744 (org-table-sort-lines nil ?t)
1745 (buffer-string))))
1746 ;; Sort with custom functions.
1747 (should
1748 (equal "| 22 |\n| 15 |\n| 18 |\n"
1749 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1750 (org-table-sort-lines nil ?f
1751 (lambda (s) (% (string-to-number s) 10))
1752 #'<)
1753 (buffer-string))))
1754 (should
1755 (equal "| 18 |\n| 15 |\n| 22 |\n"
1756 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1757 (org-table-sort-lines nil ?F
1758 (lambda (s) (% (string-to-number s) 10))
1759 #'<)
1760 (buffer-string))))
1761 ;; Sort according to current column.
1762 (should
1763 (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
1764 (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
1765 (org-table-sort-lines nil ?n)
1766 (buffer-string))))
1767 ;; Sort between horizontal separators if possible.
1768 (should
1769 (equal
1770 "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
1771 (org-test-with-temp-text
1772 "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
1773 (org-table-sort-lines nil ?n)
1774 (buffer-string)))))
1775
1776 \f
1777 ;;; Formulas
1778
1779 (ert-deftest test-org-table/eval-formula ()
1780 "Test `org-table-eval-formula' specifications."
1781 ;; Error when not on a table field.
1782 (should-error
1783 (org-test-with-temp-text "Text"
1784 (org-table-eval-formula)))
1785 (should-error
1786 (org-test-with-temp-text "| a |\n|---|<point>"
1787 (org-table-eval-formula)))
1788 (should-error
1789 (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
1790 (org-table-eval-formula)))
1791 ;; Handle @<, @>, $< and $>.
1792 (should
1793 (equal "| 1 |\n| 1 |"
1794 (org-test-with-temp-text "| <point> |\n| 1 |"
1795 (org-table-eval-formula nil "@>" nil nil t)
1796 (buffer-string))))
1797 (should
1798 (equal "| 1 |\n| 1 |"
1799 (org-test-with-temp-text "| 1 |\n| <point> |"
1800 (org-table-eval-formula nil "@<" nil nil t)
1801 (buffer-string))))
1802 (should
1803 (equal "| 1 | 1 |"
1804 (org-test-with-temp-text "| <point> | 1 |"
1805 (org-table-eval-formula nil "$>" nil nil t)
1806 (buffer-string))))
1807 (should
1808 (equal "| 1 | 1 |"
1809 (org-test-with-temp-text "| 1 | <point> |"
1810 (org-table-eval-formula nil "$<" nil nil t)
1811 (buffer-string)))))
1812
1813 (ert-deftest test-org-table/field-formula-outside-table ()
1814 "If `org-table-formula-create-columns' is nil, then a formula
1815 that references an out-of-bounds column should do nothing. If it
1816 is t, then new columns should be added as needed"
1817
1818 (let ((org-table-formula-create-columns nil))
1819
1820 (should-error
1821 (org-test-table-target-expect
1822 "
1823 | 2 |
1824 | 4 |
1825 | 8 |
1826 "
1827 "
1828 | 2 |
1829 | 4 |
1830 | 8 |
1831 "
1832 1
1833 "#+TBLFM: @1$2=5")
1834 :type (list 'error 'user-error)))
1835
1836 (let ((org-table-formula-create-columns t))
1837
1838 ;; make sure field formulas work
1839 (org-test-table-target-expect
1840 "
1841 | 2 |
1842 | 4 |
1843 | 8 |
1844 "
1845 "
1846 | 2 | 5 |
1847 | 4 | |
1848 | 8 | |
1849 "
1850 1
1851 "#+TBLFM: @1$2=5")
1852
1853 ;; and make sure column formulas work too
1854 (org-test-table-target-expect
1855 "
1856 | 2 |
1857 | 4 |
1858 | 8 |
1859 "
1860 "
1861 | 2 | | 15 |
1862 | 4 | | 15 |
1863 | 8 | | 15 |
1864 "
1865 1
1866 "#+TBLFM: $3=15")))
1867
1868 (ert-deftest test-org-table/duration ()
1869 "Test durations in table formulas."
1870 ;; Durations in cells.
1871 (should
1872 (string-match "| 2:12 | 1:47 | 03:59:00 |"
1873 (org-test-with-temp-text "
1874 | 2:12 | 1:47 | |
1875 <point>#+TBLFM: @1$3=$1+$2;T"
1876 (org-table-calc-current-TBLFM)
1877 (buffer-string))))
1878 (should
1879 (string-match "| 2:12 | 1:47 | 03:59 |"
1880 (org-test-with-temp-text "
1881 | 2:12 | 1:47 | |
1882 <point>#+TBLFM: @1$3=$1+$2;U"
1883 (org-table-calc-current-TBLFM)
1884 (buffer-string))))
1885 (should
1886 (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
1887 (org-test-with-temp-text "
1888 | 3:02:20 | -2:07:00 | |
1889 <point>#+TBLFM: @1$3=$1+$2;t"
1890 (org-table-calc-current-TBLFM)
1891 (buffer-string))))
1892 ;; Durations set through properties.
1893 (should
1894 (string-match "| 16:00:00 |"
1895 (org-test-with-temp-text "* H
1896 :PROPERTIES:
1897 :time_constant: 08:00:00
1898 :END:
1899
1900 | |
1901 <point>#+TBLFM: $1=2*$PROP_time_constant;T"
1902 (org-table-calc-current-TBLFM)
1903 (buffer-string))))
1904 (should
1905 (string-match "| 16.00 |"
1906 (org-test-with-temp-text "* H
1907 :PROPERTIES:
1908 :time_constant: 08:00:00
1909 :END:
1910
1911 | |
1912 <point>#+TBLFM: $1=2*$PROP_time_constant;t"
1913 (org-table-calc-current-TBLFM)
1914 (buffer-string)))))
1915
1916 (ert-deftest test-org-table/end-on-hline ()
1917 "Test with a table ending on a hline."
1918 (should
1919 (equal
1920 (org-test-with-temp-text
1921 "
1922 | 1 | 2 | 3 |
1923 | 4 | 5 | 6 |
1924 | | | |
1925 |---+---+---|
1926 <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
1927 (org-table-calc-current-TBLFM)
1928 (buffer-string))
1929 "
1930 | 1 | 2 | 3 |
1931 | 4 | 5 | 6 |
1932 | | 7 | 9 |
1933 |---+---+---|
1934 #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
1935
1936 (ert-deftest test-org-table/named-field ()
1937 "Test formula with a named field."
1938 (should
1939 (string-match-p
1940 "| +| +1 +|"
1941 (org-test-with-temp-text "
1942 | | |
1943 | ^ | name |
1944 <point>#+TBLFM: $name=1"
1945 (org-table-calc-current-TBLFM)
1946 (buffer-string))))
1947 (should
1948 (string-match-p
1949 "| +| +1 +|"
1950 (org-test-with-temp-text "
1951 | _ | name |
1952 | | |
1953 <point>#+TBLFM: $name=1"
1954 (org-table-calc-current-TBLFM)
1955 (buffer-string)))))
1956
1957 (ert-deftest test-org-table/named-column ()
1958 "Test formula with a named field."
1959 (should
1960 (string-match-p
1961 "| +| +1 +| +1 +|"
1962 (org-test-with-temp-text "
1963 | ! | name | |
1964 | | 1 | |
1965 <point>#+TBLFM: @2$3=$name"
1966 (org-table-calc-current-TBLFM)
1967 (buffer-string)))))
1968
1969 (ert-deftest test-org-table/formula-priority ()
1970 "Test field formula priority over column formula."
1971 ;; Field formulas bind stronger than column formulas.
1972 (should
1973 (equal
1974 "| 1 | 3 |\n| 2 | 99 |\n"
1975 (org-test-with-temp-text
1976 "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
1977 (org-table-calc-current-TBLFM)
1978 (buffer-substring-no-properties (point-min) (point)))))
1979 ;; When field formula is removed, table formulas is applied again.
1980 (should
1981 (equal
1982 "| 1 | 3 |\n| 2 | 6 |\n"
1983 (org-test-with-temp-text
1984 "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
1985 (org-table-calc-current-TBLFM)
1986 (delete-region (point) (line-end-position))
1987 (org-table-calc-current-TBLFM)
1988 (buffer-substring-no-properties (point-min) (line-beginning-position))))))
1989
1990 (ert-deftest test-org-table/tab-indent ()
1991 "Test named fields with tab indentation."
1992 (should
1993 (string-match-p
1994 "| # | 111 |"
1995 (org-test-with-temp-text
1996 "
1997 | ! | sum | | a | b | c |
1998 |---+------+------+---+----+-----|
1999 | # | 1011 | 1000 | 1 | 10 | 100 |
2000 <point>#+TBLFM: $2=$a+$b+$c
2001 "
2002 (org-table-calc-current-TBLFM)
2003 (buffer-string)))))
2004
2005 (ert-deftest test-org-table/first-rc ()
2006 "Test \"$<\" and \"@<\" constructs in formulas."
2007 (should
2008 (string-match-p
2009 "| 1 | 2 |"
2010 (org-test-with-temp-text
2011 "| | 2 |
2012 <point>#+TBLFM: $<=1"
2013 (org-table-calc-current-TBLFM)
2014 (buffer-string))))
2015 (should
2016 (string-match-p
2017 "| 2 |\n| 2 |"
2018 (org-test-with-temp-text
2019 "| 2 |\n| |
2020 <point>#+TBLFM: @2$1=@<"
2021 (org-table-calc-current-TBLFM)
2022 (buffer-string)))))
2023
2024 (ert-deftest test-org-table/last-rc ()
2025 "Test \"$>\" and \"@>\" constructs in formulas."
2026 (should
2027 (string-match-p
2028 "| 2 | 1 |"
2029 (org-test-with-temp-text
2030 "| 2 | |\n<point>#+TBLFM: $>=1"
2031 (org-table-calc-current-TBLFM)
2032 (buffer-string))))
2033 (should
2034 (string-match-p
2035 "| 2 |\n| 2 |"
2036 (org-test-with-temp-text
2037 "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
2038 (org-table-calc-current-TBLFM)
2039 (buffer-string)))))
2040
2041 (ert-deftest test-org-table/time-stamps ()
2042 "Test time-stamps handling."
2043 ;; Standard test.
2044 (should
2045 (string-match-p
2046 "| 1 |"
2047 (org-test-with-temp-text
2048 "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
2049 (org-table-calc-current-TBLFM)
2050 (buffer-string))))
2051 ;; Handle locale specific time-stamps.
2052 (should
2053 (string-match-p
2054 "| 1 |"
2055 (org-test-with-temp-text
2056 "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
2057 (org-table-calc-current-TBLFM)
2058 (buffer-string)))))
2059
2060
2061 (ert-deftest test-org-table/orgtbl-ascii-draw ()
2062 "Test `orgtbl-ascii-draw'."
2063 ;; First value: Make sure that an integer input value is converted to a
2064 ;; float before division. Further values: Show some float input value
2065 ;; ranges corresponding to the same bar width.
2066 (should
2067 (equal
2068 (org-test-with-temp-text
2069 "
2070 | Value | <l> |
2071 |----------+---------|
2072 | 19 | replace |
2073 |----------+---------|
2074 | -0.50001 | replace |
2075 | -0.49999 | replace |
2076 | 0.49999 | replace |
2077 | 0.50001 | replace |
2078 | 1.49999 | replace |
2079 | 22.50001 | replace |
2080 | 23.49999 | replace |
2081 | 23.50001 | replace |
2082 | 24.49999 | replace |
2083 | 24.50001 | replace |
2084 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
2085 (org-table-calc-current-TBLFM)
2086 (buffer-string))
2087 "
2088 | Value | <l> |
2089 |----------+-----------|
2090 | 19 | 883 |
2091 |----------+-----------|
2092 | -0.50001 | too small |
2093 | -0.49999 | |
2094 | 0.49999 | |
2095 | 0.50001 | 1 |
2096 | 1.49999 | 1 |
2097 | 22.50001 | 887 |
2098 | 23.49999 | 887 |
2099 | 23.50001 | 888 |
2100 | 24.49999 | 888 |
2101 | 24.50001 | too large |
2102 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
2103 ;; Draw bars with a bullet. The bullet does not count in the parameter
2104 ;; WIDTH of `orgtbl-ascii-draw'.
2105 (should
2106 (equal
2107 (org-test-with-temp-text
2108 "
2109 | -1 | replace |
2110 | 0 | replace |
2111 | 1 | replace |
2112 | 2 | replace |
2113 | 3 | replace |
2114 | 4 | replace |
2115 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2116 (org-table-calc-current-TBLFM)
2117 (buffer-string))
2118 "
2119 | -1 | too small |
2120 | 0 | $ |
2121 | 1 | -$ |
2122 | 2 | --$ |
2123 | 3 | ---$ |
2124 | 4 | too large |
2125 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2126
2127 (ert-deftest test-org-table/single-rowgroup ()
2128 "Test column formula in a table with a single rowgroup."
2129 (should
2130 (equal
2131 "
2132 |---+---|
2133 | 1 | 0 |
2134 |---+---|
2135 #+TBLFM: $2=$1-1"
2136 (org-test-with-temp-text "
2137 |---+---|
2138 | 1 | |
2139 |---+---|
2140 <point>#+TBLFM: $2=$1-1"
2141 (org-table-calc-current-TBLFM)
2142 (buffer-string))))
2143 (should
2144 (equal
2145 "
2146 | 1 | 0 |
2147 #+TBLFM: $2=$1-1"
2148 (org-test-with-temp-text "
2149 | 1 | |
2150 <point>#+TBLFM: $2=$1-1"
2151 (org-table-calc-current-TBLFM)
2152 (buffer-string)))))
2153
2154 \f
2155 ;;; Navigation
2156
2157 (ert-deftest test-org-table/next-field ()
2158 "Test `org-table-next-field' specifications."
2159 ;; Regular test.
2160 (should
2161 (equal
2162 "b"
2163 (org-test-with-temp-text "| a<point> | b |"
2164 (org-table-next-field)
2165 (org-trim (org-table-get-field)))))
2166 ;; Create new rows as needed.
2167 (should
2168 (equal
2169 "| a |\n| |\n"
2170 (org-test-with-temp-text "| a<point> |"
2171 (org-table-next-field)
2172 (buffer-string))))
2173 ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
2174 ;; non-nil.
2175 (should
2176 (equal
2177 "b"
2178 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2179 (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
2180 (org-trim (org-table-get-field)))))
2181 ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
2182 ;; a new row before the rule.
2183 (should
2184 (equal
2185 "| a |\n| |\n|---|\n| b |"
2186 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2187 (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
2188 (buffer-string)))))
2189
2190 (ert-deftest test-org-table/previous-field ()
2191 "Test `org-table-previous-field' specifications."
2192 ;; Regular tests.
2193 (should
2194 (eq ?a
2195 (org-test-with-temp-text "| a | <point>b |"
2196 (org-table-previous-field)
2197 (char-after))))
2198 (should
2199 (eq ?a
2200 (org-test-with-temp-text "| a |\n| <point>b |"
2201 (org-table-previous-field)
2202 (char-after))))
2203 ;; Find previous field across horizontal rules.
2204 (should
2205 (eq ?a
2206 (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
2207 (org-table-previous-field)
2208 (char-after))))
2209 ;; When called on a horizontal rule, find previous data field.
2210 (should
2211 (eq ?b
2212 (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
2213 (org-table-previous-field)
2214 (char-after))))
2215 ;; Error when at first field. Make sure to preserve original
2216 ;; position.
2217 (should-error
2218 (org-test-with-temp-text "| <point> a|"
2219 (org-table-previous-field)))
2220 (should-error
2221 (org-test-with-temp-text "|---|\n| <point>a |"
2222 (org-table-previous-field)))
2223 (should
2224 (eq ?a
2225 (org-test-with-temp-text "|---|\n| <point>a |"
2226 (ignore-errors (org-table-previous-field))
2227 (char-after)))))
2228
2229 \f
2230 ;;; Inserting rows, inserting columns
2231
2232 (ert-deftest test-org-table/insert-column ()
2233 "Test `org-table-insert-column' specifications."
2234 ;; Error when outside a table.
2235 (should-error
2236 (org-test-with-temp-text "Paragraph"
2237 (org-table-insert-column)))
2238 ;; Insert new column after current one.
2239 (should
2240 (equal "| a | |\n"
2241 (org-test-with-temp-text "| a |"
2242 (org-table-insert-column)
2243 (buffer-string))))
2244 (should
2245 (equal "| a | | b |\n"
2246 (org-test-with-temp-text "| <point>a | b |"
2247 (org-table-insert-column)
2248 (buffer-string))))
2249 ;; Move point into the newly created column.
2250 (should
2251 (equal " |"
2252 (org-test-with-temp-text "| <point>a |"
2253 (org-table-insert-column)
2254 (buffer-substring-no-properties (point) (line-end-position)))))
2255 (should
2256 (equal " | b |"
2257 (org-test-with-temp-text "| <point>a | b |"
2258 (org-table-insert-column)
2259 (buffer-substring-no-properties (point) (line-end-position)))))
2260 ;; Handle missing vertical bar in the last column.
2261 (should
2262 (equal "| a | |\n"
2263 (org-test-with-temp-text "| a"
2264 (org-table-insert-column)
2265 (buffer-string))))
2266 (should
2267 (equal " |"
2268 (org-test-with-temp-text "| <point>a"
2269 (org-table-insert-column)
2270 (buffer-substring-no-properties (point) (line-end-position)))))
2271 ;; Handle column insertion when point is before first column.
2272 (should
2273 (equal " | a | |\n"
2274 (org-test-with-temp-text " | a |"
2275 (org-table-insert-column)
2276 (buffer-string))))
2277 (should
2278 (equal " | a | | b |\n"
2279 (org-test-with-temp-text " | a | b |"
2280 (org-table-insert-column)
2281 (buffer-string)))))
2282
2283
2284 \f
2285 ;;; Moving rows, moving columns
2286
2287 (ert-deftest test-org-table/move-row-down ()
2288 "Test `org-table-move-row-down' specifications."
2289 ;; Error out when row cannot be moved, e.g., it is the last row in
2290 ;; the table.
2291 (should-error
2292 (org-test-with-temp-text "| a |"
2293 (org-table-move-row-down)))
2294 (should-error
2295 (org-test-with-temp-text "| a |\n"
2296 (org-table-move-row-down)))
2297 (should-error
2298 (org-test-with-temp-text "| a |\n| <point>b |"
2299 (org-table-move-row-down)))
2300 ;; Move data lines.
2301 (should
2302 (equal "| b |\n| a |\n"
2303 (org-test-with-temp-text "| a |\n| b |\n"
2304 (org-table-move-row-down)
2305 (buffer-string))))
2306 (should
2307 (equal "|---|\n| a |\n"
2308 (org-test-with-temp-text "| a |\n|---|\n"
2309 (org-table-move-row-down)
2310 (buffer-string))))
2311 ;; Move hlines.
2312 (should
2313 (equal "| b |\n|---|\n"
2314 (org-test-with-temp-text "|---|\n| b |\n"
2315 (org-table-move-row-down)
2316 (buffer-string))))
2317 (should
2318 (equal "|---|\n|---|\n"
2319 (org-test-with-temp-text "|---|\n|---|\n"
2320 (org-table-move-row-down)
2321 (buffer-string))))
2322 ;; Move rows even without a final newline.
2323 (should
2324 (equal "| b |\n| a |\n"
2325 (org-test-with-temp-text "| a |\n| b |"
2326 (org-table-move-row-down)
2327 (buffer-string)))))
2328
2329 (ert-deftest test-org-table/move-row-up ()
2330 "Test `org-table-move-row-up' specifications."
2331 ;; Error out when row cannot be moved, e.g., it is the first row in
2332 ;; the table.
2333 (should-error
2334 (org-test-with-temp-text "| a |"
2335 (org-table-move-row-up)))
2336 (should-error
2337 (org-test-with-temp-text "| a |\n"
2338 (org-table-move-row-up)))
2339 ;; Move data lines.
2340 (should
2341 (equal "| b |\n| a |\n"
2342 (org-test-with-temp-text "| a |\n| <point>b |\n"
2343 (org-table-move-row-up)
2344 (buffer-string))))
2345 (should
2346 (equal "| b |\n|---|\n"
2347 (org-test-with-temp-text "|---|\n| <point>b |\n"
2348 (org-table-move-row-up)
2349 (buffer-string))))
2350 ;; Move hlines.
2351 (should
2352 (equal "|---|\n| a |\n"
2353 (org-test-with-temp-text "| a |\n|<point>---|\n"
2354 (org-table-move-row-up)
2355 (buffer-string))))
2356 (should
2357 (equal "|---|\n|---|\n"
2358 (org-test-with-temp-text "|---|\n|<point>---|\n"
2359 (org-table-move-row-up)
2360 (buffer-string))))
2361 ;; Move rows even without a final newline.
2362 (should
2363 (equal "| b |\n| a |\n"
2364 (org-test-with-temp-text "| a |\n| <point>b |"
2365 (org-table-move-row-up)
2366 (buffer-string)))))
2367
2368
2369 \f
2370 ;;; Shrunk columns
2371
2372 (ert-deftest test-org-table/toggle-column-width ()
2373 "Test `org-table-toggle-columns-width' specifications."
2374 ;; Error when not at a column.
2375 (should-error
2376 (org-test-with-temp-text "<point>a"
2377 (org-table-toggle-column-width)))
2378 ;; A shrunk columns is overlaid with
2379 ;; `org-table-shrunk-column-indicator'.
2380 (should
2381 (equal org-table-shrunk-column-indicator
2382 (org-test-with-temp-text "| <point>a |"
2383 (org-table-toggle-column-width)
2384 (overlay-get (car (overlays-at (point))) 'display))))
2385 (should
2386 (equal org-table-shrunk-column-indicator
2387 (org-test-with-temp-text "| a |\n|-<point>--|"
2388 (org-table-toggle-column-width)
2389 (overlay-get (car (overlays-at (point))) 'display))))
2390 ;; Shrink every field in the same column.
2391 (should
2392 (equal org-table-shrunk-column-indicator
2393 (org-test-with-temp-text "| a |\n|-<point>--|"
2394 (org-table-toggle-column-width)
2395 (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
2396 'display))))
2397 ;; When column is already shrunk, expand it, i.e., remove overlays.
2398 (should-not
2399 (equal org-table-shrunk-column-indicator
2400 (org-test-with-temp-text "| <point>a |"
2401 (org-table-toggle-column-width)
2402 (org-table-toggle-column-width)
2403 (overlays-in (point-min) (point-max)))))
2404 (should-not
2405 (equal org-table-shrunk-column-indicator
2406 (org-test-with-temp-text "| a |\n| <point>b |"
2407 (org-table-toggle-column-width)
2408 (org-table-toggle-column-width)
2409 (overlays-in (point-min) (point-max)))))
2410 ;; With a column width cookie, limit overlay to the specified number
2411 ;; of characters.
2412 (should
2413 (equal (concat " abc" org-table-shrunk-column-indicator)
2414 (org-test-with-temp-text "| <3> |\n| <point>abcd |"
2415 (org-table-toggle-column-width)
2416 (overlay-get (car (overlays-at (point))) 'display))))
2417 (should
2418 (equal (concat " a " org-table-shrunk-column-indicator)
2419 (org-test-with-temp-text "| <3> |\n| <point>a |"
2420 (org-table-toggle-column-width)
2421 (overlay-get (car (overlays-at (point))) 'display))))
2422 ;; Only overlay visible characters of the field.
2423 (should
2424 (equal (concat " htt" org-table-shrunk-column-indicator)
2425 (org-test-with-temp-text "| <3> |\n| <point>[[http://orgmode.org]] |"
2426 (org-table-toggle-column-width)
2427 (overlay-get (car (overlays-at (point))) 'display))))
2428 ;; Before the first column or after the last one, ask for columns
2429 ;; ranges.
2430 (should
2431 (catch :exit
2432 (org-test-with-temp-text "| a |"
2433 (cl-letf (((symbol-function 'read-string)
2434 (lambda (&rest_) (throw :exit t))))
2435 (org-table-toggle-column-width)
2436 nil))))
2437 (should
2438 (catch :exit
2439 (org-test-with-temp-text "| a |<point>"
2440 (cl-letf (((symbol-function 'read-string)
2441 (lambda (&rest_) (throw :exit t))))
2442 (org-table-toggle-column-width)
2443 nil))))
2444 ;; When optional argument ARG is a string, toggle specified columns.
2445 (should
2446 (equal org-table-shrunk-column-indicator
2447 (org-test-with-temp-text "| <point>a | b |"
2448 (org-table-toggle-column-width "2")
2449 (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
2450 (should
2451 (equal '("b" "c")
2452 (org-test-with-temp-text "| a | b | c | d |"
2453 (org-table-toggle-column-width "2-3")
2454 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2455 (overlays-in (point-min) (point-max)))
2456 #'string-lessp))))
2457 (should
2458 (equal '("b" "c" "d")
2459 (org-test-with-temp-text "| a | b | c | d |"
2460 (org-table-toggle-column-width "2-")
2461 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2462 (overlays-in (point-min) (point-max)))
2463 #'string-lessp))))
2464 (should
2465 (equal '("a" "b")
2466 (org-test-with-temp-text "| a | b | c | d |"
2467 (org-table-toggle-column-width "-2")
2468 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2469 (overlays-in (point-min) (point-max)))
2470 #'string-lessp))))
2471 (should
2472 (equal '("a" "b" "c" "d")
2473 (org-test-with-temp-text "| a | b | c | d |"
2474 (org-table-toggle-column-width "-")
2475 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2476 (overlays-in (point-min) (point-max)))
2477 #'string-lessp))))
2478 (should
2479 (equal '("a" "d")
2480 (org-test-with-temp-text "| a | b | c | d |"
2481 (org-table-toggle-column-width "1-3")
2482 (org-table-toggle-column-width "2-4")
2483 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2484 (overlays-in (point-min) (point-max)))
2485 #'string-lessp))))
2486 ;; When ARG is (16), remove any column overlay.
2487 (should-not
2488 (org-test-with-temp-text "| <point>a |"
2489 (org-table-toggle-column-width)
2490 (org-table-toggle-column-width '(16))
2491 (overlays-in (point-min) (point-max))))
2492 (should-not
2493 (org-test-with-temp-text "| a | b | c | d |"
2494 (org-table-toggle-column-width "-")
2495 (org-table-toggle-column-width '(16))
2496 (overlays-in (point-min) (point-max)))))
2497
2498 (ert-deftest test-org-table/shrunk-columns ()
2499 "Test behaviour of shrunk column."
2500 ;; Edition automatically expands a shrunk column.
2501 (should-not
2502 (org-test-with-temp-text "| <point>a |"
2503 (org-table-toggle-column-width)
2504 (insert "a")
2505 (overlays-in (point-min) (point-max))))
2506 ;; Other columns are not changed.
2507 (should
2508 (org-test-with-temp-text "| <point>a | b |"
2509 (org-table-toggle-column-width "-")
2510 (insert "a")
2511 (overlays-in (point-min) (point-max))))
2512 ;; Moving a shrunk column doesn't alter its state.
2513 (should
2514 (equal "a"
2515 (org-test-with-temp-text "| <point>a | b |"
2516 (org-table-toggle-column-width)
2517 (org-table-move-column-right)
2518 (overlay-get (car (overlays-at (point))) 'help-echo))))
2519 (should
2520 (equal "a"
2521 (org-test-with-temp-text "| <point>a |\n| b |"
2522 (org-table-toggle-column-width)
2523 (org-table-move-row-down)
2524 (overlay-get (car (overlays-at (point))) 'help-echo))))
2525 ;; State is preserved upon inserting a column.
2526 (should
2527 (equal '("a")
2528 (org-test-with-temp-text "| <point>a |"
2529 (org-table-toggle-column-width)
2530 (org-table-insert-column)
2531 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2532 (overlays-in (point-min) (point-max)))
2533 #'string-lessp))))
2534 ;; State is preserved upon deleting a column.
2535 (should
2536 (equal '("a" "c")
2537 (org-test-with-temp-text "| a | <point>b | c |"
2538 (org-table-toggle-column-width "-")
2539 (org-table-delete-column)
2540 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2541 (overlays-in (point-min) (point-max)))
2542 #'string-lessp))))
2543 ;; State is preserved upon deleting a row.
2544 (should
2545 (equal '("b1" "b2")
2546 (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
2547 (org-table-toggle-column-width "-")
2548 (org-table-kill-row)
2549 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2550 (overlays-in (point-min) (point-max)))
2551 #'string-lessp))))
2552 (should
2553 (equal '("a1" "a2")
2554 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2555 (org-table-toggle-column-width "-")
2556 (org-table-kill-row)
2557 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2558 (overlays-in (point-min) (point-max)))
2559 #'string-lessp))))
2560 ;; State is preserved upon inserting a row or hline.
2561 (should
2562 (equal '("" "a1" "b1")
2563 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2564 (org-table-toggle-column-width)
2565 (org-table-insert-row)
2566 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2567 (overlays-in (point-min) (point-max)))
2568 #'string-lessp))))
2569 (should
2570 (equal '("a1" "b1")
2571 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2572 (org-table-toggle-column-width)
2573 (org-table-insert-hline)
2574 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2575 (overlays-in (point-min) (point-max)))
2576 #'string-lessp))))
2577 ;; State is preserved upon sorting a column for all the columns but
2578 ;; the one being sorted.
2579 (should
2580 (equal '("a2" "b2")
2581 (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
2582 (org-table-toggle-column-width "-")
2583 (org-table-sort-lines nil ?A)
2584 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2585 (overlays-in (point-min) (point-max)))
2586 #'string-lessp))))
2587 ;; State is preserved upon replacing a field non-interactively.
2588 (should
2589 (equal '("a")
2590 (org-test-with-temp-text "| <point>a |"
2591 (org-table-toggle-column-width)
2592 (org-table-get-field nil "b")
2593 (mapcar (lambda (o) (overlay-get o 'help-echo))
2594 (overlays-in (point-min) (point-max)))))))
2595
2596
2597 \f
2598 ;;; Miscellaneous
2599
2600 (ert-deftest test-org-table/get-field ()
2601 "Test `org-table-get-field' specifications."
2602 ;; Regular test.
2603 (should
2604 (equal " a "
2605 (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
2606 ;; Get field in open last column.
2607 (should
2608 (equal " a "
2609 (org-test-with-temp-text "| <point>a " (org-table-get-field))))
2610 ;; Get empty field.
2611 (should
2612 (equal ""
2613 (org-test-with-temp-text "|<point>|" (org-table-get-field))))
2614 (should
2615 (equal " "
2616 (org-test-with-temp-text "| <point>|" (org-table-get-field))))
2617 ;; Outside the table, return the empty string.
2618 (should
2619 (equal ""
2620 (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
2621 (should
2622 (equal ""
2623 (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
2624 ;; With optional N argument, select a particular column in current
2625 ;; row.
2626 (should
2627 (equal " 3 "
2628 (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
2629 (should
2630 (equal " 4 "
2631 (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2632 (org-table-get-field 2))))
2633 ;; REPLACE optional argument is used to replace selected field.
2634 (should
2635 (equal "| foo |"
2636 (org-test-with-temp-text "| <point>1 |"
2637 (org-table-get-field nil " foo ")
2638 (buffer-string))))
2639 (should
2640 (equal "| 1 | 2 | foo |"
2641 (org-test-with-temp-text "| 1 | 2 | 3 |"
2642 (org-table-get-field 3 " foo ")
2643 (buffer-string))))
2644 (should
2645 (equal " 4 "
2646 (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2647 (org-table-get-field 2))))
2648 ;; An empty REPLACE string clears the field.
2649 (should
2650 (equal "| |"
2651 (org-test-with-temp-text "| <point>1 |"
2652 (org-table-get-field nil "")
2653 (buffer-string))))
2654 ;; When using REPLACE still return old value.
2655 (should
2656 (equal " 1 "
2657 (org-test-with-temp-text "| <point>1 |"
2658 (org-table-get-field nil " foo ")))))
2659
2660 (provide 'test-org-table)
2661
2662 ;;; test-org-table.el ends here
org-mode fork for development of tableheadings