Merge branch 'maint'
[org-mode.git] / testing / lisp / test-org-table.el
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   (fset 'f 'org-table-make-reference)
734   ;; For Lisp formula only
735   (should (equal "0"   (f   "0"      t nil 'literal)))
736   (should (equal "z"   (f   "z"      t nil 'literal)))
737   (should (equal  ""   (f   ""       t nil 'literal)))
738   (should (equal "0 1" (f '("0" "1") t nil 'literal)))
739   (should (equal "z 1" (f '("z" "1") t nil 'literal)))
740   (should (equal  " 1" (f '(""  "1") t nil 'literal)))
741   (should (equal  " "  (f '(""  "" ) t nil 'literal))))
742
743 (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
744   (fset 'f 'org-table-make-reference)
745   ;; For Lisp formula
746   (should (equal "\"0\""       (f   "0"         t nil t)))
747   (should (equal "\"z\""       (f   "z"         t nil t)))
748   (should (equal  "\"\""       (f   ""          t nil t)))
749   (should (equal "\"0\" \"1\"" (f '("0"    "1") t nil t)))
750   (should (equal "\"z\" \"1\"" (f '("z"    "1") t nil t)))
751   (should (equal  "\"\" \"1\"" (f '(""     "1") t nil t)))
752   (should (equal  "\"\" \"\""  (f '(""     "" ) t nil t)))
753   ;; For Calc formula
754   (should (equal  "(0)"        (f   "0"         t nil nil)))
755   (should (equal  "(z)"        (f   "z"         t nil nil)))
756   (should (equal  "nan"        (f   ""          t nil nil)))
757   (should (equal  "[0,1]"      (f '("0"    "1") t nil nil)))
758   (should (equal  "[z,1]"      (f '("z"    "1") t nil nil)))
759   (should (equal  "[nan,1]"    (f '(""     "1") t nil nil)))
760   (should (equal  "[nan,nan]"  (f '(""     "" ) t nil nil)))
761   ;; For Calc formula, special numbers
762   (should (equal  "(nan)"      (f    "nan"      t nil nil)))
763   (should (equal "(uinf)"      (f   "uinf"      t nil nil)))
764   (should (equal "(-inf)"      (f   "-inf"      t nil nil)))
765   (should (equal  "(inf)"      (f    "inf"      t nil nil)))
766   (should (equal  "[nan,1]"    (f '( "nan" "1") t nil nil)))
767   (should (equal "[uinf,1]"    (f '("uinf" "1") t nil nil)))
768   (should (equal "[-inf,1]"    (f '("-inf" "1") t nil nil)))
769   (should (equal  "[inf,1]"    (f '( "inf" "1") t nil nil))))
770
771 (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
772   (fset 'f 'org-table-make-reference)
773   ;; For Lisp formula
774   (should (equal  "0"    (f   "0"         t t t)))
775   (should (equal  "0"    (f   "z"         t t t)))
776   (should (equal  "0"    (f   ""          t t t)))
777   (should (equal  "0 1"  (f '("0"    "1") t t t)))
778   (should (equal  "0 1"  (f '("z"    "1") t t t)))
779   (should (equal  "0 1"  (f '(""     "1") t t t)))
780   (should (equal  "0 0"  (f '(""     "" ) t t t)))
781   ;; For Calc formula
782   (should (equal "(0)"   (f   "0"         t t nil)))
783   (should (equal "(0)"   (f   "z"         t t nil)))
784   (should (equal "(0)"   (f   ""          t t nil)))
785   (should (equal "[0,1]" (f '("0"    "1") t t nil)))
786   (should (equal "[0,1]" (f '("z"    "1") t t nil)))
787   (should (equal "[0,1]" (f '(""     "1") t t nil)))
788   (should (equal "[0,0]" (f '(""     "" ) t t nil)))
789   ;; For Calc formula, special numbers
790   (should (equal "(0)"   (f    "nan"      t t nil)))
791   (should (equal "(0)"   (f   "uinf"      t t nil)))
792   (should (equal "(0)"   (f   "-inf"      t t nil)))
793   (should (equal "(0)"   (f    "inf"      t t nil)))
794   (should (equal "[0,1]" (f '( "nan" "1") t t nil)))
795   (should (equal "[0,1]" (f '("uinf" "1") t t nil)))
796   (should (equal "[0,1]" (f '("-inf" "1") t t nil)))
797   (should (equal "[0,1]" (f '( "inf" "1") t t nil))))
798
799 (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
800   (fset 'f 'org-table-make-reference)
801   ;; For Lisp formula only
802   (should (equal "0"   (f   "0"      nil nil 'literal)))
803   (should (equal "z"   (f   "z"      nil nil 'literal)))
804   (should (equal  ""   (f   ""       nil nil 'literal)))
805   (should (equal "0 1" (f '("0" "1") nil nil 'literal)))
806   (should (equal "z 1" (f '("z" "1") nil nil 'literal)))
807   (should (equal   "1" (f '(""  "1") nil nil 'literal)))
808   (should (equal  ""   (f '(""  "" ) nil nil 'literal))))
809
810 (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
811   (fset 'f 'org-table-make-reference)
812   ;; For Lisp formula
813   (should (equal "\"0\""       (f   "0"         nil nil t)))
814   (should (equal "\"z\""       (f   "z"         nil nil t)))
815   (should (equal   ""          (f   ""          nil nil t)))
816   (should (equal "\"0\" \"1\"" (f '("0"    "1") nil nil t)))
817   (should (equal "\"z\" \"1\"" (f '("z"    "1") nil nil t)))
818   (should (equal       "\"1\"" (f '(""     "1") nil nil t)))
819   (should (equal      ""       (f '(""     "" ) nil nil t)))
820   ;; For Calc formula
821   (should (equal  "(0)"        (f   "0"         nil nil nil)))
822   (should (equal  "(z)"        (f   "z"         nil nil nil)))
823   (should (equal  "(0)"        (f   ""          nil nil nil)))
824   (should (equal  "[0,1]"      (f '("0"    "1") nil nil nil)))
825   (should (equal  "[z,1]"      (f '("z"    "1") nil nil nil)))
826   (should (equal    "[1]"      (f '(""     "1") nil nil nil)))
827   (should (equal   "[]"        (f '(""     "" ) nil nil nil)))
828   ;; For Calc formula, special numbers
829   (should (equal  "(nan)"      (f    "nan"      nil nil nil)))
830   (should (equal "(uinf)"      (f   "uinf"      nil nil nil)))
831   (should (equal "(-inf)"      (f   "-inf"      nil nil nil)))
832   (should (equal  "(inf)"      (f    "inf"      nil nil nil)))
833   (should (equal  "[nan,1]"    (f '( "nan" "1") nil nil nil)))
834   (should (equal "[uinf,1]"    (f '("uinf" "1") nil nil nil)))
835   (should (equal "[-inf,1]"    (f '("-inf" "1") nil nil nil)))
836   (should (equal  "[inf,1]"    (f '( "inf" "1") nil nil nil))))
837
838 (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
839   (fset 'f 'org-table-make-reference)
840   ;; For Lisp formula
841   (should (equal  "0"    (f   "0"         nil t t)))
842   (should (equal  "0"    (f   "z"         nil t t)))
843   (should (equal  ""     (f   ""          nil t t)))
844   (should (equal  "0 1"  (f '("0"    "1") nil t t)))
845   (should (equal  "0 1"  (f '("z"    "1") nil t t)))
846   (should (equal    "1"  (f '(""     "1") nil t t)))
847   (should (equal   ""    (f '(""     "" ) nil t t)))
848   ;; For Calc formula
849   (should (equal "(0)"   (f   "0"         nil t nil)))
850   (should (equal "(0)"   (f   "z"         nil t nil)))
851   (should (equal "(0)"   (f   ""          nil t nil)))
852   (should (equal "[0,1]" (f '("0"    "1") nil t nil)))
853   (should (equal "[0,1]" (f '("z"    "1") nil t nil)))
854   (should (equal   "[1]" (f '(""     "1") nil t nil)))
855   (should (equal  "[]"   (f '(""     "" ) nil t nil)))
856   ;; For Calc formula, special numbers
857   (should (equal "(0)"   (f    "nan"      nil t nil)))
858   (should (equal "(0)"   (f   "uinf"      nil t nil)))
859   (should (equal "(0)"   (f   "-inf"      nil t nil)))
860   (should (equal "(0)"   (f    "inf"      nil t nil)))
861   (should (equal "[0,1]" (f '( "nan" "1") nil t nil)))
862   (should (equal "[0,1]" (f '("uinf" "1") nil t nil)))
863   (should (equal "[0,1]" (f '("-inf" "1") nil t nil)))
864   (should (equal "[0,1]" (f '( "inf" "1") nil t nil))))
865
866 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
867   "Simple reference @2$1."
868   (should
869    (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
870
871 ;; TODO: Test broken
872 ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
873 ;;   "Self reference @1$1."
874 ;;   (should
875 ;;    (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
876
877 (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
878   "Remote reference."
879   (should
880    (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
881
882 (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
883   "Simple reference @2$1."
884   (should
885    (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
886
887 (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
888   "Self reference $0."
889   (should
890    (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
891
892 ;; TODO: Test Broken
893 ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
894 ;;   "Remote reference."
895 ;;   (should
896 ;;    (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
897
898 (ert-deftest test-org-table/remote-reference-access ()
899   "Access to remote reference.
900 See also `test-org-table/copy-field'."
901   (org-test-table-target-expect
902    "
903 #+NAME: table
904 |   | x   42 |   |
905
906 | replace | replace |
907 "
908    "
909 #+NAME: table
910 |   | x   42 |   |
911
912 | x   42 | 84 x |
913 "
914    1 (concat "#+TBLFM: "
915              ;; Copy text without calculation: Use Lisp formula
916              "$1 = '(identity remote(table, @1$2)) :: "
917              ;; Do a calculation: Use Calc (or Lisp ) formula
918              "$2 = 2 * remote(table, @1$2)")))
919
920 (ert-deftest test-org-table/remote-reference-indirect ()
921   "Access to remote reference with indirection of name or ID."
922   (let ((source-tables "
923 #+NAME: 2012
924 | amount |
925 |--------|
926 |      1 |
927 |      2 |
928 |--------|
929 |      3 |
930 #+TBLFM: @>$1 = vsum(@I..@II)
931
932 #+NAME: 2013
933 | amount |
934 |--------|
935 |      4 |
936 |      8 |
937 |--------|
938 |     12 |
939 #+TBLFM: @>$1 = vsum(@I..@II)
940 "))
941
942     ;; Read several remote references from same column
943     (org-test-table-target-expect
944      (concat source-tables "
945 #+NAME: summary
946 |  year | amount  |
947 |-------+---------|
948 |  2012 | replace |
949 |  2013 | replace |
950 |-------+---------|
951 | total | replace |
952 ")
953      (concat source-tables "
954 #+NAME: summary
955 |  year | amount |
956 |-------+--------|
957 |  2012 |      3 |
958 |  2013 |     12 |
959 |-------+--------|
960 | total |     15 |
961 ")
962      1
963      ;; Calc formula
964      "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
965      ;; Lisp formula
966      (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
967              "@>$2 = '(+ @I..@II); N"))
968
969     ;; Read several remote references from same row
970     (org-test-table-target-expect
971      (concat source-tables "
972 #+NAME: summary
973 | year   |    2012 |    2013 | total   |
974 |--------+---------+---------+---------|
975 | amount | replace | replace | replace |
976 ")
977      (concat source-tables "
978 #+NAME: summary
979 | year   | 2012 | 2013 | total |
980 |--------+------+------+-------|
981 | amount |    3 |   12 |    15 |
982 ")
983      1
984      ;; Calc formula
985      "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
986      ;; Lisp formula
987      (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
988              "@2$> = '(+ $<<..$>>); N"))))
989
990 (ert-deftest test-org-table/org-at-TBLFM-p ()
991   (org-test-with-temp-text-in-file
992       "
993 | 1 |
994 | 2 |
995 #+TBLFM: $2=$1*2
996
997 "
998     (goto-char (point-min))
999     (forward-line 2)
1000     (should (equal (org-at-TBLFM-p) nil))
1001
1002     (goto-char (point-min))
1003     (forward-line 3)
1004     (should (equal (org-at-TBLFM-p) t))
1005
1006     (goto-char (point-min))
1007     (forward-line 4)
1008     (should (equal (org-at-TBLFM-p) nil))))
1009
1010 (ert-deftest test-org-table/org-table-TBLFM-begin ()
1011   (org-test-with-temp-text-in-file
1012       "
1013 | 1 |
1014 | 2 |
1015 #+TBLFM: $2=$1*2
1016
1017 "
1018     (goto-char (point-min))
1019     (should (equal (org-table-TBLFM-begin)
1020                    nil))
1021
1022     (goto-char (point-min))
1023     (forward-line 1)
1024     (should (equal (org-table-TBLFM-begin)
1025                    nil))
1026
1027     (goto-char (point-min))
1028     (forward-line 3)
1029     (should (= (org-table-TBLFM-begin)
1030                    14))
1031
1032     (goto-char (point-min))
1033     (forward-line 4)
1034     (should (= (org-table-TBLFM-begin)
1035                    14))
1036
1037     ))
1038
1039 (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
1040   "For multiple #+TBLFM lines."
1041   (org-test-with-temp-text-in-file
1042       "
1043 | 1 |
1044 | 2 |
1045 #+TBLFM: $2=$1*1
1046 #+TBLFM: $2=$1*2
1047
1048 "
1049     (goto-char (point-min))
1050     (should (equal (org-table-TBLFM-begin)
1051                    nil))
1052
1053     (goto-char (point-min))
1054     (forward-line 1)
1055     (should (equal (org-table-TBLFM-begin)
1056                    nil))
1057
1058     (goto-char (point-min))
1059     (forward-line 3)
1060     (should (= (org-table-TBLFM-begin)
1061                    14))
1062
1063     (goto-char (point-min))
1064     (forward-line 4)
1065     (should (= (org-table-TBLFM-begin)
1066                    14))
1067
1068     (goto-char (point-min))
1069     (forward-line 5)
1070     (should (= (org-table-TBLFM-begin)
1071                    14))
1072
1073     ))
1074
1075 (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
1076   (org-test-with-temp-text-in-file
1077       "
1078 | 1 |
1079 | 2 |
1080 #+TBLFM: $2=$1*1
1081 #+TBLFM: $2=$1*2
1082
1083 | 6 |
1084 | 7 |
1085 #+TBLFM: $2=$1*1
1086 #+TBLFM: $2=$1*2
1087
1088 "
1089     (goto-char (point-min))
1090     (should (equal (org-table-TBLFM-begin)
1091                    nil))
1092
1093     (goto-char (point-min))
1094     (forward-line 1)
1095     (should (equal (org-table-TBLFM-begin)
1096                    nil))
1097
1098     (goto-char (point-min))
1099     (forward-line 3)
1100     (should (= (org-table-TBLFM-begin)
1101                    14))
1102
1103     (goto-char (point-min))
1104     (forward-line 4)
1105     (should (= (org-table-TBLFM-begin)
1106                    14))
1107
1108     (goto-char (point-min))
1109     (forward-line 5)
1110     (should (= (org-table-TBLFM-begin)
1111                    14))
1112
1113     (goto-char (point-min))
1114     (forward-line 6)
1115     (should (= (org-table-TBLFM-begin)
1116                    14))
1117
1118     (goto-char (point-min))
1119     (forward-line 8)
1120     (should (= (org-table-TBLFM-begin)
1121                    61))
1122
1123     (goto-char (point-min))
1124     (forward-line 9)
1125     (should (= (org-table-TBLFM-begin)
1126                    61))
1127
1128     (goto-char (point-min))
1129     (forward-line 10)
1130     (should (= (org-table-TBLFM-begin)
1131                    61))))
1132
1133 (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
1134     (org-test-with-temp-text-in-file
1135       "
1136 | 1 |   |
1137 | 2 |   |
1138 #+TBLFM: $2=$1*1
1139 #+TBLFM: $2=$1*2
1140 #+TBLFM: $2=$1*3
1141 "
1142     (let ((got (progn (goto-char (point-min))
1143                       (forward-line 3)
1144                       (org-table-calc-current-TBLFM)
1145                       (buffer-string)))
1146           (expect "
1147 | 1 | 1 |
1148 | 2 | 2 |
1149 #+TBLFM: $2=$1*1
1150 #+TBLFM: $2=$1*2
1151 #+TBLFM: $2=$1*3
1152 "))
1153       (should (string= got
1154                        expect)))
1155
1156     (let ((got (progn (goto-char (point-min))
1157                       (forward-line 4)
1158                       (org-table-calc-current-TBLFM)
1159                       (buffer-string)))
1160           (expect "
1161 | 1 | 2 |
1162 | 2 | 4 |
1163 #+TBLFM: $2=$1*1
1164 #+TBLFM: $2=$1*2
1165 #+TBLFM: $2=$1*3
1166 "))
1167       (should (string= got
1168                        expect)))))
1169
1170 (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
1171   "org-table-calc-current-TBLFM should preserve the input as it was."
1172   (org-test-with-temp-text-in-file
1173       "
1174 | 1 | 1 |
1175 | 2 | 2 |
1176 #+TBLFM: $2=$1*1
1177 #+TBLFM: $2=$1*2::$2=$1*2
1178 #+TBLFM: $2=$1*3
1179 "
1180     (let ((expect "
1181 | 1 | 1 |
1182 | 2 | 2 |
1183 #+TBLFM: $2=$1*1
1184 #+TBLFM: $2=$1*2::$2=$1*2
1185 #+TBLFM: $2=$1*3
1186 "))
1187       (goto-char (point-min))
1188       (forward-line 4)
1189       (should-error (org-table-calc-current-TBLFM))
1190       (setq got (buffer-string))
1191       (message "%s" got)
1192       (should (string= got
1193                        expect)))))
1194
1195 ;;; Radio Tables
1196
1197 (ert-deftest test-org-table/to-generic ()
1198   "Test `orgtbl-to-generic' specifications."
1199   ;; Test :hline parameter.
1200   (should
1201    (equal "a\nb"
1202           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1203                              '(:hline nil))))
1204   (should
1205    (equal "a\n~\nb"
1206           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1207                              '(:hline "~"))))
1208   ;; Test :sep 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 "!"))))
1214   ;; Test :hsep parameter.
1215   (should
1216    (equal "a!b\nc?d"
1217           (orgtbl-to-generic
1218            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1219            '(:sep "?" :hsep "!"))))
1220   ;; Test :tstart parameter.
1221   (should
1222    (equal "<begin>\na"
1223           (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
1224   (should
1225    (equal "<begin>\na"
1226           (orgtbl-to-generic (org-table-to-lisp "| a |")
1227                              '(:tstart (lambda () "<begin>")))))
1228   (should
1229    (equal "a"
1230           (orgtbl-to-generic (org-table-to-lisp "| a |")
1231                              '(:tstart "<begin>" :splice t))))
1232   ;; Test :tend parameter.
1233   (should
1234    (equal "a\n<end>"
1235           (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
1236   (should
1237    (equal "a\n<end>"
1238           (orgtbl-to-generic (org-table-to-lisp "| a |")
1239                              '(:tend (lambda () "<end>")))))
1240   (should
1241    (equal "a"
1242           (orgtbl-to-generic (org-table-to-lisp "| a |")
1243                              '(:tend "<end>" :splice t))))
1244   ;; Test :lstart parameter.
1245   (should
1246    (equal "> a"
1247           (orgtbl-to-generic
1248            (org-table-to-lisp "| a |") '(:lstart "> "))))
1249   (should
1250    (equal "> a"
1251           (orgtbl-to-generic (org-table-to-lisp "| a |")
1252                              '(:lstart (lambda () "> ")))))
1253   ;; Test :llstart parameter.
1254   (should
1255    (equal "> a\n>> b"
1256           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1257                              '(:lstart "> " :llstart ">> "))))
1258   ;; Test :hlstart parameter.
1259   (should
1260    (equal "!> a\n> b"
1261           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1262                              '(:lstart "> " :hlstart "!> "))))
1263   ;; Test :hllstart parameter.
1264   (should
1265    (equal "!> a\n!!> b\n> c"
1266           (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1267                              '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
1268   ;; Test :lend parameter.
1269   (should
1270    (equal "a <"
1271           (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
1272   ;; Test :llend parameter.
1273   (should
1274    (equal "a <\nb <<"
1275           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1276                              '(:lend " <" :llend " <<"))))
1277   ;; Test :hlend parameter.
1278   (should
1279    (equal "a <!\nb <"
1280           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1281                              '(:lend " <" :hlend " <!"))))
1282   ;; Test :hllend parameter.
1283   (should
1284    (equal "a <!\nb <!!\nc <"
1285           (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1286                              '(:lend " <" :hlend " <!" :hllend " <!!"))))
1287   ;; Test :lfmt parameter.
1288   (should
1289    (equal "a!b"
1290           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1291                              '(:lfmt "%s!%s"))))
1292   (should
1293    (equal "a+b"
1294           (orgtbl-to-generic
1295            (org-table-to-lisp "| a | b |")
1296            '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1297   (should
1298    (equal "a!b"
1299           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1300                              '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1301   ;; Test :llfmt parameter.
1302   (should
1303    (equal "a!b"
1304           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1305                              '(:llfmt "%s!%s"))))
1306   (should
1307    (equal "a!b\nc+d"
1308           (orgtbl-to-generic
1309            (org-table-to-lisp "| a | b |\n| c | d |")
1310            '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1311   (should
1312    (equal "a!b"
1313           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1314                              '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1315   ;; Test :hlfmt parameter.
1316   (should
1317    (equal "a!b\ncd"
1318           (orgtbl-to-generic
1319            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1320            '(:hlfmt "%s!%s"))))
1321   (should
1322    (equal "a+b\ncd"
1323           (orgtbl-to-generic
1324            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1325            '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1326   (should
1327    (equal "a!b\n>c d<"
1328           (orgtbl-to-generic
1329            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1330            '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1331   ;; Test :hllfmt parameter.
1332   (should
1333    (equal "a!b\ncd"
1334           (orgtbl-to-generic
1335            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1336            '(:hllfmt "%s!%s"))))
1337   (should
1338    (equal "a+b\ncd"
1339           (orgtbl-to-generic
1340            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1341            '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1342   (should
1343    (equal "a!b\n>c d<"
1344           (orgtbl-to-generic
1345            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1346            '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1347   ;; Test :fmt parameter.
1348   (should
1349    (equal ">a<\n>b<"
1350           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1351                              '(:fmt ">%s<"))))
1352   (should
1353    (equal ">a<b"
1354           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1355                              '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
1356   (should
1357    (equal "a b"
1358           (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1359                              '(:fmt (2 " %s")))))
1360   (should
1361    (equal ">a<"
1362           (orgtbl-to-generic (org-table-to-lisp "| a |")
1363                              '(:fmt (lambda (c) (format ">%s<" c))))))
1364   ;; Test :hfmt parameter.
1365   (should
1366    (equal ">a<\nb"
1367           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1368                              '(:hfmt ">%s<"))))
1369   (should
1370    (equal ">a<b\ncd"
1371           (orgtbl-to-generic
1372            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1373            '(:hfmt (1 ">%s<" 2 identity)))))
1374   (should
1375    (equal "a b\ncd"
1376           (orgtbl-to-generic
1377            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1378            '(:hfmt (2 " %s")))))
1379   (should
1380    (equal ">a<\nb"
1381           (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1382                              '(:hfmt (lambda (c) (format ">%s<" c))))))
1383   ;; Test :efmt parameter.
1384   (should
1385    (equal "2x10^3"
1386           (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1387                              '(:efmt "%sx10^%s"))))
1388   (should
1389    (equal "2x10^3"
1390           (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1391                              '(:efmt (lambda (m e) (concat m "x10^" e))))))
1392   (should
1393    (equal "2x10^3"
1394           (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1395                              '(:efmt (1 "%sx10^%s")))))
1396   (should
1397    (equal "2x10^3"
1398           (orgtbl-to-generic
1399            (org-table-to-lisp "| 2e3 |")
1400            '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
1401   (should
1402    (equal "2e3"
1403           (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
1404   ;; Test :skip parameter.
1405   (should
1406    (equal "cd"
1407           (orgtbl-to-generic
1408            (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
1409            '(:skip 2))))
1410   ;; Test :skipcols parameter.
1411   (should
1412    (equal "a\nc"
1413           (orgtbl-to-generic
1414            (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
1415   (should
1416    (equal "a\nc"
1417           (orgtbl-to-generic
1418            (org-table-to-lisp
1419             "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n|   | c | d |")
1420            '(:skipcols (2)))))
1421   ;; Test :raw parameter.
1422   (when (featurep 'ox-latex)
1423     (should
1424      (string-match-p
1425       "/a/"
1426       (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
1427                          '(:backend latex :raw t)))))
1428   ;; Hooks are ignored.
1429   (should
1430    (equal
1431     "a\nb"
1432     (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
1433            (org-export-before-parsing-hook fun-list)
1434            (org-export-before-processing-hook fun-list))
1435       (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1436                          '(:hline nil)))))
1437   ;; User-defined export filters are ignored.
1438   (should
1439    (equal
1440     "a\nb"
1441     (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
1442       (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1443                          '(:hline nil)))))
1444   ;; Macros, even if unknown, are returned as-is.
1445   (should
1446    (equal "{{{macro}}}"
1447           (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
1448
1449 (ert-deftest test-org-table/to-latex ()
1450   "Test `orgtbl-to-latex' specifications."
1451   (should
1452    (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
1453           (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
1454   ;; Test :environment parameter.
1455   (should
1456    (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
1457           (orgtbl-to-latex (org-table-to-lisp "| a |")
1458                            '(:environment "tabularx"))))
1459   ;; Test :booktabs parameter.
1460   (should
1461    (string-match-p
1462     "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
1463   ;; Handle LaTeX snippets.
1464   (should
1465    (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
1466           (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
1467   ;; Test pseudo objects and :raw parameter.
1468   (should
1469    (string-match-p
1470     "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
1471
1472 (ert-deftest test-org-table/to-html ()
1473   "Test `orgtbl-to-html' specifications."
1474   (should
1475    (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
1476           "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
1477
1478
1479 <colgroup>
1480 <col  class=\"org-left\" />
1481 </colgroup>
1482 <tbody>
1483 <tr>
1484 <td class=\"org-left\">a</td>
1485 </tr>
1486 </tbody>
1487 </table>"))
1488   ;; Test :attributes parameter.
1489   (should
1490    (string-match-p
1491     "<table>"
1492     (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
1493   (should
1494    (string-match-p
1495     "<table border=\"2\">"
1496     (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
1497
1498 (ert-deftest test-org-table/to-texinfo ()
1499   "Test `orgtbl-to-texinfo' specifications."
1500   (should
1501    (equal "@multitable {a}\n@item a\n@end multitable"
1502           (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
1503   ;; Test :columns parameter.
1504   (should
1505    (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1506           (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1507                              '(:columns ".4 .6"))))
1508   (should
1509    (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1510           (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1511                              '(:columns "@columnfractions .4 .6"))))
1512   (should
1513    (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
1514           (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1515                              '(:columns "{xxx} {xx}")))))
1516
1517 (ert-deftest test-org-table/to-orgtbl ()
1518   "Test `orgtbl-to-orgtbl' specifications."
1519   (should
1520    (equal "| a | b |\n|---+---|\n| c | d |"
1521           (orgtbl-to-orgtbl
1522            (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
1523
1524 (ert-deftest test-org-table/to-unicode ()
1525   "Test `orgtbl-to-unicode' specifications."
1526   (should
1527    (equal "━━━\n a \n━━━"
1528           (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
1529   ;; Test :narrow parameter.
1530   (should
1531    (equal "━━━━\n => \n━━━━"
1532           (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
1533                              '(:narrow t)))))
1534
1535 (ert-deftest test-org-table/send-region ()
1536   "Test `orgtbl-send-table' specifications."
1537   ;; Error when not at a table.
1538   (should-error
1539    (org-test-with-temp-text "Paragraph"
1540      (orgtbl-send-table)))
1541   ;; Error when destination is missing.
1542   (should-error
1543    (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
1544      (orgtbl-send-table)))
1545   ;; Error when transformation function is not specified.
1546   (should-error
1547    (org-test-with-temp-text "
1548 # BEGIN RECEIVE ORGTBL table
1549 # END RECEIVE ORGTBL table
1550 #+ORGTBL: SEND table
1551 <point>| a |"
1552      (orgtbl-send-table)))
1553   ;; Standard test.
1554   (should
1555    (equal "| a |\n|---|\n| b |\n"
1556           (org-test-with-temp-text "
1557 # BEGIN RECEIVE ORGTBL table
1558 # END RECEIVE ORGTBL table
1559 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1560 <point>| a |\n|---|\n| b |"
1561             (orgtbl-send-table)
1562             (goto-char (point-min))
1563             (buffer-substring-no-properties
1564              (search-forward "# BEGIN RECEIVE ORGTBL table\n")
1565              (progn (search-forward "# END RECEIVE ORGTBL table")
1566                     (match-beginning 0))))))
1567   ;; Allow multiple receiver locations.
1568   (should
1569    (org-test-with-temp-text "
1570 # BEGIN RECEIVE ORGTBL table
1571 # END RECEIVE ORGTBL table
1572
1573 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1574 <point>| a |
1575
1576 # BEGIN RECEIVE ORGTBL table
1577 # END RECEIVE ORGTBL table"
1578      (orgtbl-send-table)
1579      (goto-char (point-min))
1580      (search-forward "| a |" nil t 3))))
1581
1582 \f
1583 ;;; Align
1584
1585 (ert-deftest test-org-table/align ()
1586   "Test `org-table-align' specifications."
1587   ;; Regular test.
1588   (should
1589    (equal "| a |\n"
1590           (org-test-with-temp-text "|   a |"
1591             (org-table-align)
1592             (buffer-string))))
1593   ;; Preserve alignment.
1594   (should
1595    (equal "  | a |\n"
1596           (org-test-with-temp-text "  |   a |"
1597             (org-table-align)
1598             (buffer-string))))
1599   ;; Handle horizontal lines.
1600   (should
1601    (equal "| 123 |\n|-----|\n"
1602           (org-test-with-temp-text "| 123 |\n|-|"
1603             (org-table-align)
1604             (buffer-string))))
1605   (should
1606    (equal "| a | b |\n|---+---|\n"
1607           (org-test-with-temp-text "| a | b |\n|-+-|"
1608             (org-table-align)
1609             (buffer-string))))
1610   ;; Handle empty fields.
1611   (should
1612    (equal "| a   | bc |\n| bcd |    |\n"
1613           (org-test-with-temp-text "| a | bc |\n| bcd |  |"
1614             (org-table-align)
1615             (buffer-string))))
1616   (should
1617    (equal "| abc | bc  |\n|     | bcd |\n"
1618           (org-test-with-temp-text "| abc | bc |\n| | bcd |"
1619             (org-table-align)
1620             (buffer-string))))
1621   ;; Handle missing fields.
1622   (should
1623    (equal "| a | b |\n| c |   |\n"
1624           (org-test-with-temp-text "| a | b |\n| c |"
1625             (org-table-align)
1626             (buffer-string))))
1627   (should
1628    (equal "| a | b |\n|---+---|\n"
1629           (org-test-with-temp-text "| a | b |\n|---|"
1630             (org-table-align)
1631             (buffer-string))))
1632   ;; Alignment is done to the right when the ratio of numbers in the
1633   ;; column is superior to `org-table-number-fraction'.
1634   (should
1635    (equal "|   1 |\n|  12 |\n| abc |"
1636           (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
1637             (let ((org-table-number-fraction 0.5)) (org-table-align))
1638             (buffer-string))))
1639   (should
1640    (equal "| 1   |\n| ab  |\n| abc |"
1641           (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
1642             (let ((org-table-number-fraction 0.5)) (org-table-align))
1643             (buffer-string))))
1644   ;; Obey to alignment cookies.
1645   (should
1646    (equal "| <r> |\n|  ab |\n| abc |"
1647           (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
1648             (let ((org-table-number-fraction 0.5)) (org-table-align))
1649             (buffer-string))))
1650   (should
1651    (equal "| <l> |\n| 12  |\n| 123 |"
1652           (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
1653             (let ((org-table-number-fraction 0.5)) (org-table-align))
1654             (buffer-string))))
1655   (should
1656    (equal "| <c> |\n|  1  |\n| 123 |"
1657           (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
1658             (let ((org-table-number-fraction 0.5)) (org-table-align))
1659             (buffer-string)))))
1660
1661 (ert-deftest test-org-table/align-buffer-tables ()
1662   "Align all tables when updating buffer."
1663   (let ((before "
1664 |  a  b  |
1665
1666 |  c  d  |
1667 ")
1668         (after "
1669 | a  b |
1670
1671 | c  d |
1672 "))
1673     (should (equal (org-test-with-temp-text before
1674                      (org-table-recalculate-buffer-tables)
1675                      (buffer-string))
1676                    after))
1677     (should (equal (org-test-with-temp-text before
1678                      (org-table-iterate-buffer-tables)
1679                      (buffer-string))
1680                    after))))
1681
1682 \f
1683 ;;; Sorting
1684
1685 (ert-deftest test-org-table/sort-lines ()
1686   "Test `org-table-sort-lines' specifications."
1687   ;; Sort numerically.
1688   (should
1689    (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
1690           (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1691             (org-table-sort-lines nil ?n)
1692             (buffer-string))))
1693   (should
1694    (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
1695           (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1696             (org-table-sort-lines nil ?N)
1697             (buffer-string))))
1698   ;; Sort alphabetically.
1699   (should
1700    (equal "| a | x |\n| b | 4 |\n| c | 3 |\n"
1701           (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1702             (org-table-sort-lines nil ?a)
1703             (buffer-string))))
1704   (should
1705    (equal "| c | 3 |\n| b | 4 |\n| a | x |\n"
1706           (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1707             (org-table-sort-lines nil ?A)
1708             (buffer-string))))
1709   ;; Sort alphabetically with case.
1710   (should
1711    (equal "| C |\n| a |\n| b |\n"
1712           (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1713             (org-table-sort-lines t ?a)
1714             (buffer-string))))
1715   (should
1716    (equal "| b |\n| a |\n| C |\n"
1717           (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1718             (org-table-sort-lines nil ?A)
1719             (buffer-string))))
1720   ;; Sort by time (timestamps)
1721   (should
1722    (equal
1723     "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
1724     (org-test-with-temp-text
1725         "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1726       (org-table-sort-lines nil ?t)
1727       (buffer-string))))
1728   (should
1729    (equal
1730     "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
1731     (org-test-with-temp-text
1732         "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1733       (org-table-sort-lines nil ?T)
1734       (buffer-string))))
1735   ;; Sort by time (HH:MM values)
1736   (should
1737    (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
1738           (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1739             (org-table-sort-lines nil ?t)
1740             (buffer-string))))
1741   (should
1742    (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1743           (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1744             (org-table-sort-lines nil ?T)
1745             (buffer-string))))
1746   ;; Sort by time (durations)
1747   (should
1748    (equal "| 1d 3:00 |\n| 28:00 |\n"
1749           (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
1750             (org-table-sort-lines nil ?t)
1751             (buffer-string))))
1752   ;; Sort with custom functions.
1753   (should
1754    (equal "| 22 |\n| 15 |\n| 18 |\n"
1755           (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1756             (org-table-sort-lines nil ?f
1757                                   (lambda (s) (% (string-to-number s) 10))
1758                                   #'<)
1759             (buffer-string))))
1760   (should
1761    (equal "| 18 |\n| 15 |\n| 22 |\n"
1762           (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1763             (org-table-sort-lines nil ?F
1764                                   (lambda (s) (% (string-to-number s) 10))
1765                                   #'<)
1766             (buffer-string))))
1767   ;; Sort according to current column.
1768   (should
1769    (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
1770           (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
1771             (org-table-sort-lines nil ?n)
1772             (buffer-string))))
1773   ;; Sort between horizontal separators if possible.
1774   (should
1775    (equal
1776     "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
1777     (org-test-with-temp-text
1778         "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
1779       (org-table-sort-lines nil ?n)
1780       (buffer-string)))))
1781
1782 \f
1783 ;;; Formulas
1784
1785 (ert-deftest test-org-table/eval-formula ()
1786   "Test `org-table-eval-formula' specifications."
1787   ;; Error when not on a table field.
1788   (should-error
1789    (org-test-with-temp-text "Text"
1790      (org-table-eval-formula)))
1791   (should-error
1792    (org-test-with-temp-text "| a |\n|---|<point>"
1793      (org-table-eval-formula)))
1794   (should-error
1795    (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
1796      (org-table-eval-formula)))
1797   ;; Handle @<, @>, $< and $>.
1798   (should
1799    (equal "| 1 |\n| 1 |"
1800           (org-test-with-temp-text "| <point>  |\n| 1 |"
1801             (org-table-eval-formula nil "@>" nil nil t)
1802             (buffer-string))))
1803   (should
1804    (equal "| 1 |\n| 1 |"
1805           (org-test-with-temp-text "| 1 |\n| <point>  |"
1806             (org-table-eval-formula nil "@<" nil nil t)
1807             (buffer-string))))
1808   (should
1809    (equal "| 1 | 1 |"
1810           (org-test-with-temp-text "| <point>  | 1 |"
1811             (org-table-eval-formula nil "$>" nil nil t)
1812             (buffer-string))))
1813   (should
1814    (equal "| 1 | 1 |"
1815           (org-test-with-temp-text "| 1 | <point>  |"
1816             (org-table-eval-formula nil "$<" nil nil t)
1817             (buffer-string)))))
1818
1819 (ert-deftest test-org-table/field-formula-outside-table ()
1820   "If `org-table-formula-create-columns' is nil, then a formula
1821 that references an out-of-bounds column should do nothing. If it
1822 is t, then new columns should be added as needed"
1823
1824   (let ((org-table-formula-create-columns nil))
1825
1826     (should-error
1827      (org-test-table-target-expect
1828       "
1829 | 2 |
1830 | 4 |
1831 | 8 |
1832 "
1833       "
1834 | 2 |
1835 | 4 |
1836 | 8 |
1837 "
1838       1
1839       "#+TBLFM: @1$2=5")
1840      :type (list 'error 'user-error)))
1841
1842   (let ((org-table-formula-create-columns t))
1843
1844     ;; make sure field formulas work
1845     (org-test-table-target-expect
1846      "
1847 | 2 |
1848 | 4 |
1849 | 8 |
1850 "
1851      "
1852 | 2 | 5 |
1853 | 4 |   |
1854 | 8 |   |
1855 "
1856      1
1857      "#+TBLFM: @1$2=5")
1858
1859     ;; and make sure column formulas work too
1860     (org-test-table-target-expect
1861      "
1862 | 2 |
1863 | 4 |
1864 | 8 |
1865 "
1866      "
1867 | 2 |   | 15 |
1868 | 4 |   | 15 |
1869 | 8 |   | 15 |
1870 "
1871      1
1872      "#+TBLFM: $3=15")))
1873
1874 (ert-deftest test-org-table/duration ()
1875   "Test durations in table formulas."
1876   ;; Durations in cells.
1877   (should
1878    (string-match "| 2:12 | 1:47 | 03:59:00 |"
1879                  (org-test-with-temp-text "
1880        | 2:12 | 1:47 | |
1881        <point>#+TBLFM: @1$3=$1+$2;T"
1882                    (org-table-calc-current-TBLFM)
1883                    (buffer-string))))
1884   (should
1885    (string-match "| 2:12 | 1:47 | 03:59 |"
1886                  (org-test-with-temp-text "
1887        | 2:12 | 1:47 | |
1888        <point>#+TBLFM: @1$3=$1+$2;U"
1889                    (org-table-calc-current-TBLFM)
1890                    (buffer-string))))
1891   (should
1892    (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
1893                  (org-test-with-temp-text "
1894        | 3:02:20 | -2:07:00 | |
1895        <point>#+TBLFM: @1$3=$1+$2;t"
1896                    (org-table-calc-current-TBLFM)
1897                    (buffer-string))))
1898   ;; Durations set through properties.
1899   (should
1900    (string-match "| 16:00:00 |"
1901                  (org-test-with-temp-text "* H
1902   :PROPERTIES:
1903   :time_constant: 08:00:00
1904   :END:
1905
1906   |  |
1907   <point>#+TBLFM: $1=2*$PROP_time_constant;T"
1908                    (org-table-calc-current-TBLFM)
1909                    (buffer-string))))
1910   (should
1911    (string-match "| 16.00 |"
1912                  (org-test-with-temp-text "* H
1913   :PROPERTIES:
1914   :time_constant: 08:00:00
1915   :END:
1916
1917   |  |
1918   <point>#+TBLFM: $1=2*$PROP_time_constant;t"
1919                    (org-table-calc-current-TBLFM)
1920                    (buffer-string)))))
1921
1922 (ert-deftest test-org-table/end-on-hline ()
1923   "Test with a table ending on a hline."
1924   (should
1925    (equal
1926     (org-test-with-temp-text
1927         "
1928 | 1 | 2 | 3 |
1929 | 4 | 5 | 6 |
1930 |   |   |   |
1931 |---+---+---|
1932 <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
1933       (org-table-calc-current-TBLFM)
1934       (buffer-string))
1935     "
1936 | 1 | 2 | 3 |
1937 | 4 | 5 | 6 |
1938 |   | 7 | 9 |
1939 |---+---+---|
1940 #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
1941
1942 (ert-deftest test-org-table/named-field ()
1943   "Test formula with a named field."
1944   (should
1945    (string-match-p
1946     "| +| +1 +|"
1947     (org-test-with-temp-text "
1948 |   |      |
1949 | ^ | name |
1950 <point>#+TBLFM: $name=1"
1951       (org-table-calc-current-TBLFM)
1952       (buffer-string))))
1953   (should
1954    (string-match-p
1955     "| +| +1 +|"
1956     (org-test-with-temp-text "
1957 | _ | name |
1958 |   |      |
1959 <point>#+TBLFM: $name=1"
1960       (org-table-calc-current-TBLFM)
1961       (buffer-string)))))
1962
1963 (ert-deftest test-org-table/named-column ()
1964   "Test formula with a named field."
1965   (should
1966    (string-match-p
1967     "| +| +1 +| +1 +|"
1968     (org-test-with-temp-text "
1969 | ! | name |   |
1970 |   |    1 |   |
1971 <point>#+TBLFM: @2$3=$name"
1972       (org-table-calc-current-TBLFM)
1973       (buffer-string)))))
1974
1975 (ert-deftest test-org-table/tab-indent ()
1976   "Test named fields with tab indentation."
1977   (should
1978    (string-match-p
1979     "| # | 111 |"
1980     (org-test-with-temp-text
1981         "
1982         | ! |  sum |      | a |  b |   c |
1983         |---+------+------+---+----+-----|
1984         | # | 1011 | 1000 | 1 | 10 | 100 |
1985         <point>#+TBLFM: $2=$a+$b+$c
1986 "
1987       (org-table-calc-current-TBLFM)
1988       (buffer-string)))))
1989
1990 (ert-deftest test-org-table/first-rc ()
1991   "Test \"$<\" and \"@<\" constructs in formulas."
1992   (should
1993    (string-match-p
1994     "| 1 | 2 |"
1995     (org-test-with-temp-text
1996         "|   | 2 |
1997 <point>#+TBLFM: $<=1"
1998       (org-table-calc-current-TBLFM)
1999       (buffer-string))))
2000   (should
2001    (string-match-p
2002     "| 2 |\n| 2 |"
2003     (org-test-with-temp-text
2004         "| 2 |\n|   |
2005 <point>#+TBLFM: @2$1=@<"
2006       (org-table-calc-current-TBLFM)
2007       (buffer-string)))))
2008
2009 (ert-deftest test-org-table/last-rc ()
2010   "Test \"$>\" and \"@>\" constructs in formulas."
2011   (should
2012    (string-match-p
2013     "| 2 | 1 |"
2014     (org-test-with-temp-text
2015         "| 2 |   |\n<point>#+TBLFM: $>=1"
2016       (org-table-calc-current-TBLFM)
2017       (buffer-string))))
2018   (should
2019    (string-match-p
2020     "| 2 |\n| 2 |"
2021     (org-test-with-temp-text
2022         "| 2 |\n|   |\n<point>#+TBLFM: @>$1=@<"
2023       (org-table-calc-current-TBLFM)
2024       (buffer-string)))))
2025
2026 (ert-deftest test-org-table/time-stamps ()
2027   "Test time-stamps handling."
2028   ;; Standard test.
2029   (should
2030    (string-match-p
2031     "| 1 |"
2032     (org-test-with-temp-text
2033         "| <2016-07-07 Sun> | <2016-07-08 Fri> |   |\n<point>#+TBLFM: $3=$2-$1"
2034       (org-table-calc-current-TBLFM)
2035       (buffer-string))))
2036   ;; Handle locale specific time-stamps.
2037   (should
2038    (string-match-p
2039     "| 1 |"
2040     (org-test-with-temp-text
2041         "| <2016-07-07 Do> | <2016-07-08 Fr> |   |\n<point>#+TBLFM: $3=$2-$1"
2042       (org-table-calc-current-TBLFM)
2043       (buffer-string)))))
2044
2045
2046 (ert-deftest test-org-table/orgtbl-ascii-draw ()
2047   "Test `orgtbl-ascii-draw'."
2048   ;; First value: Make sure that an integer input value is converted to a
2049   ;; float before division. Further values: Show some float input value
2050   ;; ranges corresponding to the same bar width.
2051   (should
2052    (equal
2053     (org-test-with-temp-text
2054         "
2055 |    Value | <l>     |
2056 |----------+---------|
2057 |       19 | replace |
2058 |----------+---------|
2059 | -0.50001 | replace |
2060 | -0.49999 | replace |
2061 |  0.49999 | replace |
2062 |  0.50001 | replace |
2063 |  1.49999 | replace |
2064 | 22.50001 | replace |
2065 | 23.49999 | replace |
2066 | 23.50001 | replace |
2067 | 24.49999 | replace |
2068 | 24.50001 | replace |
2069 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
2070       (org-table-calc-current-TBLFM)
2071       (buffer-string))
2072     "
2073 |    Value | <l>       |
2074 |----------+-----------|
2075 |       19 | 883       |
2076 |----------+-----------|
2077 | -0.50001 | too small |
2078 | -0.49999 |           |
2079 |  0.49999 |           |
2080 |  0.50001 | 1         |
2081 |  1.49999 | 1         |
2082 | 22.50001 | 887       |
2083 | 23.49999 | 887       |
2084 | 23.50001 | 888       |
2085 | 24.49999 | 888       |
2086 | 24.50001 | too large |
2087 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
2088   ;; Draw bars with a bullet. The bullet does not count in the parameter
2089   ;; WIDTH of `orgtbl-ascii-draw'.
2090   (should
2091    (equal
2092     (org-test-with-temp-text
2093         "
2094 | -1 | replace |
2095 |  0 | replace |
2096 |  1 | replace |
2097 |  2 | replace |
2098 |  3 | replace |
2099 |  4 | replace |
2100 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2101       (org-table-calc-current-TBLFM)
2102       (buffer-string))
2103     "
2104 | -1 | too small |
2105 |  0 | $         |
2106 |  1 | -$        |
2107 |  2 | --$       |
2108 |  3 | ---$      |
2109 |  4 | too large |
2110 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2111
2112 (ert-deftest test-org-table/single-rowgroup ()
2113   "Test column formula in a table with a single rowgroup."
2114   (should
2115    (equal
2116     "
2117 |---+---|
2118 | 1 | 0 |
2119 |---+---|
2120 #+TBLFM: $2=$1-1"
2121     (org-test-with-temp-text "
2122 |---+---|
2123 | 1 |   |
2124 |---+---|
2125 <point>#+TBLFM: $2=$1-1"
2126       (org-table-calc-current-TBLFM)
2127       (buffer-string))))
2128   (should
2129    (equal
2130     "
2131 | 1 | 0 |
2132 #+TBLFM: $2=$1-1"
2133     (org-test-with-temp-text "
2134 | 1 |   |
2135 <point>#+TBLFM: $2=$1-1"
2136       (org-table-calc-current-TBLFM)
2137       (buffer-string)))))
2138
2139 \f
2140 ;;; Navigation
2141
2142 (ert-deftest test-org-table/next-field ()
2143   "Test `org-table-next-field' specifications."
2144   ;; Regular test.
2145   (should
2146    (equal
2147     "b"
2148     (org-test-with-temp-text "| a<point> | b |"
2149       (org-table-next-field)
2150       (org-trim (org-table-get-field)))))
2151   ;; Create new rows as needed.
2152   (should
2153    (equal
2154     "| a |\n|   |\n"
2155     (org-test-with-temp-text "| a<point> |"
2156       (org-table-next-field)
2157       (buffer-string))))
2158   ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
2159   ;; non-nil.
2160   (should
2161    (equal
2162     "b"
2163     (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2164       (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
2165       (org-trim (org-table-get-field)))))
2166   ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
2167   ;; a new row before the rule.
2168   (should
2169    (equal
2170     "| a |\n|   |\n|---|\n| b |"
2171     (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2172       (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
2173       (buffer-string)))))
2174
2175 (ert-deftest test-org-table/previous-field ()
2176   "Test `org-table-previous-field' specifications."
2177   ;; Regular tests.
2178   (should
2179    (eq ?a
2180        (org-test-with-temp-text "| a | <point>b |"
2181          (org-table-previous-field)
2182          (char-after))))
2183   (should
2184    (eq ?a
2185        (org-test-with-temp-text "| a |\n| <point>b |"
2186          (org-table-previous-field)
2187          (char-after))))
2188   ;; Find previous field across horizontal rules.
2189   (should
2190    (eq ?a
2191        (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
2192          (org-table-previous-field)
2193          (char-after))))
2194   ;; When called on a horizontal rule, find previous data field.
2195   (should
2196    (eq ?b
2197        (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
2198          (org-table-previous-field)
2199          (char-after))))
2200   ;; Error when at first field.  Make sure to preserve original
2201   ;; position.
2202   (should-error
2203    (org-test-with-temp-text "| <point> a|"
2204      (org-table-previous-field)))
2205   (should-error
2206    (org-test-with-temp-text "|---|\n| <point>a |"
2207      (org-table-previous-field)))
2208   (should
2209    (eq ?a
2210        (org-test-with-temp-text "|---|\n| <point>a |"
2211          (ignore-errors (org-table-previous-field))
2212          (char-after)))))
2213
2214
2215 \f
2216 ;;; Moving rows, moving columns
2217
2218 (ert-deftest test-org-table/move-row-down ()
2219   "Test `org-table-move-row-down' specifications."
2220   ;; Error out when row cannot be moved, e.g., it is the last row in
2221   ;; the table.
2222   (should-error
2223    (org-test-with-temp-text "| a |"
2224      (org-table-move-row-down)))
2225   (should-error
2226    (org-test-with-temp-text "| a |\n"
2227      (org-table-move-row-down)))
2228   (should-error
2229    (org-test-with-temp-text "| a |\n| <point>b |"
2230      (org-table-move-row-down)))
2231   ;; Move data lines.
2232   (should
2233    (equal "| b |\n| a |\n"
2234           (org-test-with-temp-text "| a |\n| b |\n"
2235             (org-table-move-row-down)
2236             (buffer-string))))
2237   (should
2238    (equal "|---|\n| a |\n"
2239           (org-test-with-temp-text "| a |\n|---|\n"
2240             (org-table-move-row-down)
2241             (buffer-string))))
2242   ;; Move hlines.
2243   (should
2244    (equal "| b |\n|---|\n"
2245           (org-test-with-temp-text "|---|\n| b |\n"
2246             (org-table-move-row-down)
2247             (buffer-string))))
2248   (should
2249    (equal "|---|\n|---|\n"
2250           (org-test-with-temp-text "|---|\n|---|\n"
2251             (org-table-move-row-down)
2252             (buffer-string))))
2253   ;; Move rows even without a final newline.
2254   (should
2255    (equal "| b |\n| a |\n"
2256           (org-test-with-temp-text "| a |\n| b |"
2257             (org-table-move-row-down)
2258             (buffer-string)))))
2259
2260 (ert-deftest test-org-table/move-row-up ()
2261   "Test `org-table-move-row-up' specifications."
2262   ;; Error out when row cannot be moved, e.g., it is the first row in
2263   ;; the table.
2264   (should-error
2265    (org-test-with-temp-text "| a |"
2266      (org-table-move-row-up)))
2267   (should-error
2268    (org-test-with-temp-text "| a |\n"
2269      (org-table-move-row-up)))
2270   ;; Move data lines.
2271   (should
2272    (equal "| b |\n| a |\n"
2273           (org-test-with-temp-text "| a |\n| <point>b |\n"
2274             (org-table-move-row-up)
2275             (buffer-string))))
2276   (should
2277    (equal "| b |\n|---|\n"
2278           (org-test-with-temp-text "|---|\n| <point>b |\n"
2279             (org-table-move-row-up)
2280             (buffer-string))))
2281   ;; Move hlines.
2282   (should
2283    (equal "|---|\n| a |\n"
2284           (org-test-with-temp-text "| a |\n|<point>---|\n"
2285             (org-table-move-row-up)
2286             (buffer-string))))
2287   (should
2288    (equal "|---|\n|---|\n"
2289           (org-test-with-temp-text "|---|\n|<point>---|\n"
2290             (org-table-move-row-up)
2291             (buffer-string))))
2292   ;; Move rows even without a final newline.
2293   (should
2294    (equal "| b |\n| a |\n"
2295           (org-test-with-temp-text "| a |\n| <point>b |"
2296             (org-table-move-row-up)
2297             (buffer-string)))))
2298
2299
2300 \f
2301 ;;; Shrunk columns
2302
2303 (ert-deftest test-org-table/toggle-column-width ()
2304   "Test `org-table-toggle-columns-width' specifications."
2305   ;; Error when not at a column.
2306   (should-error
2307    (org-test-with-temp-text "<point>a"
2308      (org-table-toggle-column-width)))
2309   ;; A shrunk columns is overlaid with
2310   ;; `org-table-shrunk-column-indicator'.
2311   (should
2312    (equal org-table-shrunk-column-indicator
2313           (org-test-with-temp-text "| <point>a |"
2314             (org-table-toggle-column-width)
2315             (overlay-get (car (overlays-at (point))) 'display))))
2316   (should
2317    (equal org-table-shrunk-column-indicator
2318           (org-test-with-temp-text "| a |\n|-<point>--|"
2319             (org-table-toggle-column-width)
2320             (overlay-get (car (overlays-at (point))) 'display))))
2321   ;; Shrink every field in the same column.
2322   (should
2323    (equal org-table-shrunk-column-indicator
2324           (org-test-with-temp-text "| a |\n|-<point>--|"
2325             (org-table-toggle-column-width)
2326             (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
2327                          'display))))
2328   ;; When column is already shrunk, expand it, i.e., remove overlays.
2329   (should-not
2330    (equal org-table-shrunk-column-indicator
2331           (org-test-with-temp-text "| <point>a |"
2332             (org-table-toggle-column-width)
2333             (org-table-toggle-column-width)
2334             (overlays-in (point-min) (point-max)))))
2335   (should-not
2336    (equal org-table-shrunk-column-indicator
2337           (org-test-with-temp-text "| a |\n| <point>b |"
2338             (org-table-toggle-column-width)
2339             (org-table-toggle-column-width)
2340             (overlays-in (point-min) (point-max)))))
2341   ;; With a column width cookie, limit overlay to the specified number
2342   ;; of characters.
2343   (should
2344    (equal (concat " abc" org-table-shrunk-column-indicator)
2345           (org-test-with-temp-text "| <3> |\n| <point>abcd |"
2346             (org-table-toggle-column-width)
2347             (overlay-get (car (overlays-at (point))) 'display))))
2348   (should
2349    (equal (concat " a  " org-table-shrunk-column-indicator)
2350           (org-test-with-temp-text "| <3> |\n| <point>a |"
2351             (org-table-toggle-column-width)
2352             (overlay-get (car (overlays-at (point))) 'display))))
2353   ;; Only overlay visible characters of the field.
2354   (should
2355    (equal (concat " htt" org-table-shrunk-column-indicator)
2356           (org-test-with-temp-text "| <3> |\n| <point>[[http://orgmode.org]] |"
2357             (org-table-toggle-column-width)
2358             (overlay-get (car (overlays-at (point))) 'display))))
2359   ;; Before the first column or after the last one, ask for columns
2360   ;; ranges.
2361   (should
2362    (catch :exit
2363      (org-test-with-temp-text "| a |"
2364        (cl-letf (((symbol-function 'read-string)
2365                   (lambda (&rest_) (throw :exit t))))
2366          (org-table-toggle-column-width)
2367          nil))))
2368   (should
2369    (catch :exit
2370      (org-test-with-temp-text "| a |<point>"
2371        (cl-letf (((symbol-function 'read-string)
2372                   (lambda (&rest_) (throw :exit t))))
2373          (org-table-toggle-column-width)
2374          nil))))
2375   ;; When optional argument ARG is a string, toggle specified columns.
2376   (should
2377    (equal org-table-shrunk-column-indicator
2378           (org-test-with-temp-text "| <point>a | b |"
2379             (org-table-toggle-column-width "2")
2380             (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
2381   (should
2382    (equal '("b" "c")
2383           (org-test-with-temp-text "| a | b | c | d |"
2384             (org-table-toggle-column-width "2-3")
2385             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2386                           (overlays-in (point-min) (point-max)))
2387                   #'string-lessp))))
2388   (should
2389    (equal '("b" "c" "d")
2390           (org-test-with-temp-text "| a | b | c | d |"
2391             (org-table-toggle-column-width "2-")
2392             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2393                           (overlays-in (point-min) (point-max)))
2394                   #'string-lessp))))
2395   (should
2396    (equal '("a" "b")
2397           (org-test-with-temp-text "| a | b | c | d |"
2398             (org-table-toggle-column-width "-2")
2399             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2400                           (overlays-in (point-min) (point-max)))
2401                   #'string-lessp))))
2402   (should
2403    (equal '("a" "b" "c" "d")
2404           (org-test-with-temp-text "| a | b | c | d |"
2405             (org-table-toggle-column-width "-")
2406             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2407                           (overlays-in (point-min) (point-max)))
2408                   #'string-lessp))))
2409   (should
2410    (equal '("a" "d")
2411           (org-test-with-temp-text "| a | b | c | d |"
2412             (org-table-toggle-column-width "1-3")
2413             (org-table-toggle-column-width "2-4")
2414             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2415                           (overlays-in (point-min) (point-max)))
2416                   #'string-lessp))))
2417   ;; When ARG is (16), remove any column overlay.
2418   (should-not
2419    (org-test-with-temp-text "| <point>a |"
2420      (org-table-toggle-column-width)
2421      (org-table-toggle-column-width '(16))
2422      (overlays-in (point-min) (point-max))))
2423   (should-not
2424    (org-test-with-temp-text "| a | b | c | d |"
2425      (org-table-toggle-column-width "-")
2426      (org-table-toggle-column-width '(16))
2427      (overlays-in (point-min) (point-max)))))
2428
2429 (ert-deftest test-org-table/shrunk-columns ()
2430   "Test behaviour of shrunk column."
2431   ;; Edition automatically expands a shrunk column.
2432   (should-not
2433    (org-test-with-temp-text "| <point>a |"
2434      (org-table-toggle-column-width)
2435      (insert "a")
2436      (overlays-in (point-min) (point-max))))
2437   ;; Other columns are not changed.
2438   (should
2439    (org-test-with-temp-text "| <point>a | b |"
2440      (org-table-toggle-column-width "-")
2441      (insert "a")
2442      (overlays-in (point-min) (point-max))))
2443   ;; Moving a shrunk column doesn't alter its state.
2444   (should
2445    (equal "a"
2446           (org-test-with-temp-text "| <point>a | b |"
2447             (org-table-toggle-column-width)
2448             (org-table-move-column-right)
2449             (overlay-get (car (overlays-at (point))) 'help-echo))))
2450   (should
2451    (equal "a"
2452           (org-test-with-temp-text "| <point>a |\n| b |"
2453             (org-table-toggle-column-width)
2454             (org-table-move-row-down)
2455             (overlay-get (car (overlays-at (point))) 'help-echo))))
2456   ;; State is preserved upon inserting a column.
2457   (should
2458    (equal '("a")
2459           (org-test-with-temp-text "| <point>a |"
2460             (org-table-toggle-column-width)
2461             (org-table-insert-column)
2462             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2463                           (overlays-in (point-min) (point-max)))
2464                   #'string-lessp))))
2465   ;; State is preserved upon deleting a column.
2466   (should
2467    (equal '("a" "c")
2468           (org-test-with-temp-text "| a | <point>b | c |"
2469             (org-table-toggle-column-width "-")
2470             (org-table-delete-column)
2471             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2472                           (overlays-in (point-min) (point-max)))
2473                   #'string-lessp))))
2474   ;; State is preserved upon deleting a row.
2475   (should
2476    (equal '("b1" "b2")
2477           (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
2478             (org-table-toggle-column-width "-")
2479             (org-table-kill-row)
2480             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2481                           (overlays-in (point-min) (point-max)))
2482                   #'string-lessp))))
2483   (should
2484    (equal '("a1" "a2")
2485           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2486             (org-table-toggle-column-width "-")
2487             (org-table-kill-row)
2488             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2489                           (overlays-in (point-min) (point-max)))
2490                   #'string-lessp))))
2491   ;; State is preserved upon inserting a row or hline.
2492   (should
2493    (equal '("" "a1" "b1")
2494           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2495             (org-table-toggle-column-width)
2496             (org-table-insert-row)
2497             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2498                           (overlays-in (point-min) (point-max)))
2499                   #'string-lessp))))
2500   (should
2501    (equal '("a1" "b1")
2502           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2503             (org-table-toggle-column-width)
2504             (org-table-insert-hline)
2505             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2506                           (overlays-in (point-min) (point-max)))
2507                   #'string-lessp))))
2508   ;; State is preserved upon sorting a column for all the columns but
2509   ;; the one being sorted.
2510   (should
2511    (equal '("a2" "b2")
2512           (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
2513             (org-table-toggle-column-width "-")
2514             (org-table-sort-lines nil ?A)
2515             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2516                           (overlays-in (point-min) (point-max)))
2517                   #'string-lessp))))
2518   ;; State is preserved upon replacing a field non-interactively.
2519   (should
2520    (equal '("a")
2521           (org-test-with-temp-text "| <point>a |"
2522             (org-table-toggle-column-width)
2523             (org-table-get-field nil "b")
2524             (mapcar (lambda (o) (overlay-get o 'help-echo))
2525                     (overlays-in (point-min) (point-max)))))))
2526
2527
2528 \f
2529 ;;; Miscellaneous
2530
2531 (ert-deftest test-org-table/get-field ()
2532   "Test `org-table-get-field' specifications."
2533   ;; Regular test.
2534   (should
2535    (equal " a "
2536           (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
2537   ;; Get field in open last column.
2538   (should
2539    (equal " a "
2540           (org-test-with-temp-text "| <point>a " (org-table-get-field))))
2541   ;; Get empty field.
2542   (should
2543    (equal ""
2544           (org-test-with-temp-text "|<point>|" (org-table-get-field))))
2545   (should
2546    (equal " "
2547           (org-test-with-temp-text "| <point>|" (org-table-get-field))))
2548   ;; Outside the table, return the empty string.
2549   (should
2550    (equal ""
2551           (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
2552   (should
2553    (equal ""
2554           (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
2555   ;; With optional N argument, select a particular column in current
2556   ;; row.
2557   (should
2558    (equal " 3 "
2559           (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
2560   (should
2561    (equal " 4 "
2562           (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2563             (org-table-get-field 2))))
2564   ;; REPLACE optional argument is used to replace selected field.
2565   (should
2566    (equal "| foo |"
2567           (org-test-with-temp-text "| <point>1 |"
2568             (org-table-get-field nil " foo ")
2569             (buffer-string))))
2570   (should
2571    (equal "| 1 | 2 | foo |"
2572           (org-test-with-temp-text "| 1 | 2 | 3 |"
2573             (org-table-get-field 3 " foo ")
2574             (buffer-string))))
2575   (should
2576    (equal " 4 "
2577           (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2578             (org-table-get-field 2))))
2579   ;; An empty REPLACE string clears the field.
2580   (should
2581    (equal "| |"
2582           (org-test-with-temp-text "| <point>1 |"
2583             (org-table-get-field nil "")
2584             (buffer-string))))
2585   ;; When using REPLACE still return old value.
2586   (should
2587    (equal " 1 "
2588           (org-test-with-temp-text "| <point>1 |"
2589             (org-table-get-field nil " foo ")))))
2590
2591 (provide 'test-org-table)
2592
2593 ;;; test-org-table.el ends here