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