org-archive: Add a test
[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/formula-priority ()
1976   "Test field formula priority over column formula."
1977   ;; Field formulas bind stronger than column formulas.
1978   (should
1979    (equal
1980     "| 1 |  3 |\n| 2 | 99 |\n"
1981     (org-test-with-temp-text
1982         "| 1 |   |\n| 2 |   |\n<point>#+tblfm: $2=3*$1::@2$2=99"
1983       (org-table-calc-current-TBLFM)
1984       (buffer-substring-no-properties (point-min) (point)))))
1985   ;; When field formula is removed, table formulas is applied again.
1986   (should
1987    (equal
1988     "| 1 | 3 |\n| 2 | 6 |\n"
1989     (org-test-with-temp-text
1990         "| 1 |   |\n| 2 |   |\n#+tblfm: $2=3*$1<point>::@2$2=99"
1991       (org-table-calc-current-TBLFM)
1992       (delete-region (point) (line-end-position))
1993       (org-table-calc-current-TBLFM)
1994       (buffer-substring-no-properties (point-min) (line-beginning-position))))))
1995
1996 (ert-deftest test-org-table/tab-indent ()
1997   "Test named fields with tab indentation."
1998   (should
1999    (string-match-p
2000     "| # | 111 |"
2001     (org-test-with-temp-text
2002         "
2003         | ! |  sum |      | a |  b |   c |
2004         |---+------+------+---+----+-----|
2005         | # | 1011 | 1000 | 1 | 10 | 100 |
2006         <point>#+TBLFM: $2=$a+$b+$c
2007 "
2008       (org-table-calc-current-TBLFM)
2009       (buffer-string)))))
2010
2011 (ert-deftest test-org-table/first-rc ()
2012   "Test \"$<\" and \"@<\" constructs in formulas."
2013   (should
2014    (string-match-p
2015     "| 1 | 2 |"
2016     (org-test-with-temp-text
2017         "|   | 2 |
2018 <point>#+TBLFM: $<=1"
2019       (org-table-calc-current-TBLFM)
2020       (buffer-string))))
2021   (should
2022    (string-match-p
2023     "| 2 |\n| 2 |"
2024     (org-test-with-temp-text
2025         "| 2 |\n|   |
2026 <point>#+TBLFM: @2$1=@<"
2027       (org-table-calc-current-TBLFM)
2028       (buffer-string)))))
2029
2030 (ert-deftest test-org-table/last-rc ()
2031   "Test \"$>\" and \"@>\" constructs in formulas."
2032   (should
2033    (string-match-p
2034     "| 2 | 1 |"
2035     (org-test-with-temp-text
2036         "| 2 |   |\n<point>#+TBLFM: $>=1"
2037       (org-table-calc-current-TBLFM)
2038       (buffer-string))))
2039   (should
2040    (string-match-p
2041     "| 2 |\n| 2 |"
2042     (org-test-with-temp-text
2043         "| 2 |\n|   |\n<point>#+TBLFM: @>$1=@<"
2044       (org-table-calc-current-TBLFM)
2045       (buffer-string)))))
2046
2047 (ert-deftest test-org-table/time-stamps ()
2048   "Test time-stamps handling."
2049   ;; Standard test.
2050   (should
2051    (string-match-p
2052     "| 1 |"
2053     (org-test-with-temp-text
2054         "| <2016-07-07 Sun> | <2016-07-08 Fri> |   |\n<point>#+TBLFM: $3=$2-$1"
2055       (org-table-calc-current-TBLFM)
2056       (buffer-string))))
2057   ;; Handle locale specific time-stamps.
2058   (should
2059    (string-match-p
2060     "| 1 |"
2061     (org-test-with-temp-text
2062         "| <2016-07-07 Do> | <2016-07-08 Fr> |   |\n<point>#+TBLFM: $3=$2-$1"
2063       (org-table-calc-current-TBLFM)
2064       (buffer-string)))))
2065
2066
2067 (ert-deftest test-org-table/orgtbl-ascii-draw ()
2068   "Test `orgtbl-ascii-draw'."
2069   ;; First value: Make sure that an integer input value is converted to a
2070   ;; float before division. Further values: Show some float input value
2071   ;; ranges corresponding to the same bar width.
2072   (should
2073    (equal
2074     (org-test-with-temp-text
2075         "
2076 |    Value | <l>     |
2077 |----------+---------|
2078 |       19 | replace |
2079 |----------+---------|
2080 | -0.50001 | replace |
2081 | -0.49999 | replace |
2082 |  0.49999 | replace |
2083 |  0.50001 | replace |
2084 |  1.49999 | replace |
2085 | 22.50001 | replace |
2086 | 23.49999 | replace |
2087 | 23.50001 | replace |
2088 | 24.49999 | replace |
2089 | 24.50001 | replace |
2090 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
2091       (org-table-calc-current-TBLFM)
2092       (buffer-string))
2093     "
2094 |    Value | <l>       |
2095 |----------+-----------|
2096 |       19 | 883       |
2097 |----------+-----------|
2098 | -0.50001 | too small |
2099 | -0.49999 |           |
2100 |  0.49999 |           |
2101 |  0.50001 | 1         |
2102 |  1.49999 | 1         |
2103 | 22.50001 | 887       |
2104 | 23.49999 | 887       |
2105 | 23.50001 | 888       |
2106 | 24.49999 | 888       |
2107 | 24.50001 | too large |
2108 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
2109   ;; Draw bars with a bullet. The bullet does not count in the parameter
2110   ;; WIDTH of `orgtbl-ascii-draw'.
2111   (should
2112    (equal
2113     (org-test-with-temp-text
2114         "
2115 | -1 | replace |
2116 |  0 | replace |
2117 |  1 | replace |
2118 |  2 | replace |
2119 |  3 | replace |
2120 |  4 | replace |
2121 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2122       (org-table-calc-current-TBLFM)
2123       (buffer-string))
2124     "
2125 | -1 | too small |
2126 |  0 | $         |
2127 |  1 | -$        |
2128 |  2 | --$       |
2129 |  3 | ---$      |
2130 |  4 | too large |
2131 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2132
2133 (ert-deftest test-org-table/single-rowgroup ()
2134   "Test column formula in a table with a single rowgroup."
2135   (should
2136    (equal
2137     "
2138 |---+---|
2139 | 1 | 0 |
2140 |---+---|
2141 #+TBLFM: $2=$1-1"
2142     (org-test-with-temp-text "
2143 |---+---|
2144 | 1 |   |
2145 |---+---|
2146 <point>#+TBLFM: $2=$1-1"
2147       (org-table-calc-current-TBLFM)
2148       (buffer-string))))
2149   (should
2150    (equal
2151     "
2152 | 1 | 0 |
2153 #+TBLFM: $2=$1-1"
2154     (org-test-with-temp-text "
2155 | 1 |   |
2156 <point>#+TBLFM: $2=$1-1"
2157       (org-table-calc-current-TBLFM)
2158       (buffer-string)))))
2159
2160 \f
2161 ;;; Navigation
2162
2163 (ert-deftest test-org-table/next-field ()
2164   "Test `org-table-next-field' specifications."
2165   ;; Regular test.
2166   (should
2167    (equal
2168     "b"
2169     (org-test-with-temp-text "| a<point> | b |"
2170       (org-table-next-field)
2171       (org-trim (org-table-get-field)))))
2172   ;; Create new rows as needed.
2173   (should
2174    (equal
2175     "| a |\n|   |\n"
2176     (org-test-with-temp-text "| a<point> |"
2177       (org-table-next-field)
2178       (buffer-string))))
2179   ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
2180   ;; non-nil.
2181   (should
2182    (equal
2183     "b"
2184     (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2185       (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
2186       (org-trim (org-table-get-field)))))
2187   ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
2188   ;; a new row before the rule.
2189   (should
2190    (equal
2191     "| a |\n|   |\n|---|\n| b |"
2192     (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2193       (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
2194       (buffer-string)))))
2195
2196 (ert-deftest test-org-table/previous-field ()
2197   "Test `org-table-previous-field' specifications."
2198   ;; Regular tests.
2199   (should
2200    (eq ?a
2201        (org-test-with-temp-text "| a | <point>b |"
2202          (org-table-previous-field)
2203          (char-after))))
2204   (should
2205    (eq ?a
2206        (org-test-with-temp-text "| a |\n| <point>b |"
2207          (org-table-previous-field)
2208          (char-after))))
2209   ;; Find previous field across horizontal rules.
2210   (should
2211    (eq ?a
2212        (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
2213          (org-table-previous-field)
2214          (char-after))))
2215   ;; When called on a horizontal rule, find previous data field.
2216   (should
2217    (eq ?b
2218        (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
2219          (org-table-previous-field)
2220          (char-after))))
2221   ;; Error when at first field.  Make sure to preserve original
2222   ;; position.
2223   (should-error
2224    (org-test-with-temp-text "| <point> a|"
2225      (org-table-previous-field)))
2226   (should-error
2227    (org-test-with-temp-text "|---|\n| <point>a |"
2228      (org-table-previous-field)))
2229   (should
2230    (eq ?a
2231        (org-test-with-temp-text "|---|\n| <point>a |"
2232          (ignore-errors (org-table-previous-field))
2233          (char-after)))))
2234
2235 \f
2236 ;;; Inserting rows, inserting columns
2237
2238 (ert-deftest test-org-table/insert-column ()
2239   "Test `org-table-insert-column' specifications."
2240   ;; Error when outside a table.
2241   (should-error
2242    (org-test-with-temp-text "Paragraph"
2243      (org-table-insert-column)))
2244   ;; Insert new column after current one.
2245   (should
2246    (equal "| a |   |\n"
2247           (org-test-with-temp-text "| a |"
2248             (org-table-insert-column)
2249             (buffer-string))))
2250   (should
2251    (equal "| a |   | b |\n"
2252           (org-test-with-temp-text "| <point>a | b |"
2253             (org-table-insert-column)
2254             (buffer-string))))
2255   ;; Move point into the newly created column.
2256   (should
2257    (equal "  |"
2258           (org-test-with-temp-text "| <point>a |"
2259             (org-table-insert-column)
2260             (buffer-substring-no-properties (point) (line-end-position)))))
2261   (should
2262    (equal "  | b |"
2263           (org-test-with-temp-text "| <point>a | b |"
2264             (org-table-insert-column)
2265             (buffer-substring-no-properties (point) (line-end-position)))))
2266   ;; Handle missing vertical bar in the last column.
2267   (should
2268    (equal "| a |   |\n"
2269           (org-test-with-temp-text "| a"
2270             (org-table-insert-column)
2271             (buffer-string))))
2272   (should
2273    (equal "  |"
2274           (org-test-with-temp-text "| <point>a"
2275             (org-table-insert-column)
2276             (buffer-substring-no-properties (point) (line-end-position)))))
2277   ;; Handle column insertion when point is before first column.
2278   (should
2279    (equal " | a |   |\n"
2280           (org-test-with-temp-text " | a |"
2281             (org-table-insert-column)
2282             (buffer-string))))
2283   (should
2284    (equal " | a |   | b |\n"
2285           (org-test-with-temp-text " | a | b |"
2286             (org-table-insert-column)
2287             (buffer-string)))))
2288
2289
2290 \f
2291 ;;; Moving rows, moving columns
2292
2293 (ert-deftest test-org-table/move-row-down ()
2294   "Test `org-table-move-row-down' specifications."
2295   ;; Error out when row cannot be moved, e.g., it is the last row in
2296   ;; the table.
2297   (should-error
2298    (org-test-with-temp-text "| a |"
2299      (org-table-move-row-down)))
2300   (should-error
2301    (org-test-with-temp-text "| a |\n"
2302      (org-table-move-row-down)))
2303   (should-error
2304    (org-test-with-temp-text "| a |\n| <point>b |"
2305      (org-table-move-row-down)))
2306   ;; Move data lines.
2307   (should
2308    (equal "| b |\n| a |\n"
2309           (org-test-with-temp-text "| a |\n| b |\n"
2310             (org-table-move-row-down)
2311             (buffer-string))))
2312   (should
2313    (equal "|---|\n| a |\n"
2314           (org-test-with-temp-text "| a |\n|---|\n"
2315             (org-table-move-row-down)
2316             (buffer-string))))
2317   ;; Move hlines.
2318   (should
2319    (equal "| b |\n|---|\n"
2320           (org-test-with-temp-text "|---|\n| b |\n"
2321             (org-table-move-row-down)
2322             (buffer-string))))
2323   (should
2324    (equal "|---|\n|---|\n"
2325           (org-test-with-temp-text "|---|\n|---|\n"
2326             (org-table-move-row-down)
2327             (buffer-string))))
2328   ;; Move rows even without a final newline.
2329   (should
2330    (equal "| b |\n| a |\n"
2331           (org-test-with-temp-text "| a |\n| b |"
2332             (org-table-move-row-down)
2333             (buffer-string)))))
2334
2335 (ert-deftest test-org-table/move-row-up ()
2336   "Test `org-table-move-row-up' specifications."
2337   ;; Error out when row cannot be moved, e.g., it is the first row in
2338   ;; the table.
2339   (should-error
2340    (org-test-with-temp-text "| a |"
2341      (org-table-move-row-up)))
2342   (should-error
2343    (org-test-with-temp-text "| a |\n"
2344      (org-table-move-row-up)))
2345   ;; Move data lines.
2346   (should
2347    (equal "| b |\n| a |\n"
2348           (org-test-with-temp-text "| a |\n| <point>b |\n"
2349             (org-table-move-row-up)
2350             (buffer-string))))
2351   (should
2352    (equal "| b |\n|---|\n"
2353           (org-test-with-temp-text "|---|\n| <point>b |\n"
2354             (org-table-move-row-up)
2355             (buffer-string))))
2356   ;; Move hlines.
2357   (should
2358    (equal "|---|\n| a |\n"
2359           (org-test-with-temp-text "| a |\n|<point>---|\n"
2360             (org-table-move-row-up)
2361             (buffer-string))))
2362   (should
2363    (equal "|---|\n|---|\n"
2364           (org-test-with-temp-text "|---|\n|<point>---|\n"
2365             (org-table-move-row-up)
2366             (buffer-string))))
2367   ;; Move rows even without a final newline.
2368   (should
2369    (equal "| b |\n| a |\n"
2370           (org-test-with-temp-text "| a |\n| <point>b |"
2371             (org-table-move-row-up)
2372             (buffer-string)))))
2373
2374
2375 \f
2376 ;;; Shrunk columns
2377
2378 (ert-deftest test-org-table/toggle-column-width ()
2379   "Test `org-table-toggle-columns-width' specifications."
2380   ;; Error when not at a column.
2381   (should-error
2382    (org-test-with-temp-text "<point>a"
2383      (org-table-toggle-column-width)))
2384   ;; A shrunk columns is overlaid with
2385   ;; `org-table-shrunk-column-indicator'.
2386   (should
2387    (equal org-table-shrunk-column-indicator
2388           (org-test-with-temp-text "| <point>a |"
2389             (org-table-toggle-column-width)
2390             (overlay-get (car (overlays-at (point))) 'display))))
2391   (should
2392    (equal org-table-shrunk-column-indicator
2393           (org-test-with-temp-text "| a |\n|-<point>--|"
2394             (org-table-toggle-column-width)
2395             (overlay-get (car (overlays-at (point))) 'display))))
2396   ;; Shrink every field in the same column.
2397   (should
2398    (equal org-table-shrunk-column-indicator
2399           (org-test-with-temp-text "| a |\n|-<point>--|"
2400             (org-table-toggle-column-width)
2401             (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
2402                          'display))))
2403   ;; When column is already shrunk, expand it, i.e., remove overlays.
2404   (should-not
2405    (equal org-table-shrunk-column-indicator
2406           (org-test-with-temp-text "| <point>a |"
2407             (org-table-toggle-column-width)
2408             (org-table-toggle-column-width)
2409             (overlays-in (point-min) (point-max)))))
2410   (should-not
2411    (equal org-table-shrunk-column-indicator
2412           (org-test-with-temp-text "| a |\n| <point>b |"
2413             (org-table-toggle-column-width)
2414             (org-table-toggle-column-width)
2415             (overlays-in (point-min) (point-max)))))
2416   ;; With a column width cookie, limit overlay to the specified number
2417   ;; of characters.
2418   (should
2419    (equal (concat " abc" org-table-shrunk-column-indicator)
2420           (org-test-with-temp-text "| <3> |\n| <point>abcd |"
2421             (org-table-toggle-column-width)
2422             (overlay-get (car (overlays-at (point))) 'display))))
2423   (should
2424    (equal (concat " a  " org-table-shrunk-column-indicator)
2425           (org-test-with-temp-text "| <3> |\n| <point>a |"
2426             (org-table-toggle-column-width)
2427             (overlay-get (car (overlays-at (point))) 'display))))
2428   ;; Only overlay visible characters of the field.
2429   (should
2430    (equal (concat " htt" org-table-shrunk-column-indicator)
2431           (org-test-with-temp-text "| <3> |\n| <point>[[http://orgmode.org]] |"
2432             (org-table-toggle-column-width)
2433             (overlay-get (car (overlays-at (point))) 'display))))
2434   ;; Before the first column or after the last one, ask for columns
2435   ;; ranges.
2436   (should
2437    (catch :exit
2438      (org-test-with-temp-text "| a |"
2439        (cl-letf (((symbol-function 'read-string)
2440                   (lambda (&rest_) (throw :exit t))))
2441          (org-table-toggle-column-width)
2442          nil))))
2443   (should
2444    (catch :exit
2445      (org-test-with-temp-text "| a |<point>"
2446        (cl-letf (((symbol-function 'read-string)
2447                   (lambda (&rest_) (throw :exit t))))
2448          (org-table-toggle-column-width)
2449          nil))))
2450   ;; When optional argument ARG is a string, toggle specified columns.
2451   (should
2452    (equal org-table-shrunk-column-indicator
2453           (org-test-with-temp-text "| <point>a | b |"
2454             (org-table-toggle-column-width "2")
2455             (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
2456   (should
2457    (equal '("b" "c")
2458           (org-test-with-temp-text "| a | b | c | d |"
2459             (org-table-toggle-column-width "2-3")
2460             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2461                           (overlays-in (point-min) (point-max)))
2462                   #'string-lessp))))
2463   (should
2464    (equal '("b" "c" "d")
2465           (org-test-with-temp-text "| a | b | c | d |"
2466             (org-table-toggle-column-width "2-")
2467             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2468                           (overlays-in (point-min) (point-max)))
2469                   #'string-lessp))))
2470   (should
2471    (equal '("a" "b")
2472           (org-test-with-temp-text "| a | b | c | d |"
2473             (org-table-toggle-column-width "-2")
2474             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2475                           (overlays-in (point-min) (point-max)))
2476                   #'string-lessp))))
2477   (should
2478    (equal '("a" "b" "c" "d")
2479           (org-test-with-temp-text "| a | b | c | d |"
2480             (org-table-toggle-column-width "-")
2481             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2482                           (overlays-in (point-min) (point-max)))
2483                   #'string-lessp))))
2484   (should
2485    (equal '("a" "d")
2486           (org-test-with-temp-text "| a | b | c | d |"
2487             (org-table-toggle-column-width "1-3")
2488             (org-table-toggle-column-width "2-4")
2489             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2490                           (overlays-in (point-min) (point-max)))
2491                   #'string-lessp))))
2492   ;; When ARG is (16), remove any column overlay.
2493   (should-not
2494    (org-test-with-temp-text "| <point>a |"
2495      (org-table-toggle-column-width)
2496      (org-table-toggle-column-width '(16))
2497      (overlays-in (point-min) (point-max))))
2498   (should-not
2499    (org-test-with-temp-text "| a | b | c | d |"
2500      (org-table-toggle-column-width "-")
2501      (org-table-toggle-column-width '(16))
2502      (overlays-in (point-min) (point-max)))))
2503
2504 (ert-deftest test-org-table/shrunk-columns ()
2505   "Test behaviour of shrunk column."
2506   ;; Edition automatically expands a shrunk column.
2507   (should-not
2508    (org-test-with-temp-text "| <point>a |"
2509      (org-table-toggle-column-width)
2510      (insert "a")
2511      (overlays-in (point-min) (point-max))))
2512   ;; Other columns are not changed.
2513   (should
2514    (org-test-with-temp-text "| <point>a | b |"
2515      (org-table-toggle-column-width "-")
2516      (insert "a")
2517      (overlays-in (point-min) (point-max))))
2518   ;; Moving a shrunk column doesn't alter its state.
2519   (should
2520    (equal "a"
2521           (org-test-with-temp-text "| <point>a | b |"
2522             (org-table-toggle-column-width)
2523             (org-table-move-column-right)
2524             (overlay-get (car (overlays-at (point))) 'help-echo))))
2525   (should
2526    (equal "a"
2527           (org-test-with-temp-text "| <point>a |\n| b |"
2528             (org-table-toggle-column-width)
2529             (org-table-move-row-down)
2530             (overlay-get (car (overlays-at (point))) 'help-echo))))
2531   ;; State is preserved upon inserting a column.
2532   (should
2533    (equal '("a")
2534           (org-test-with-temp-text "| <point>a |"
2535             (org-table-toggle-column-width)
2536             (org-table-insert-column)
2537             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2538                           (overlays-in (point-min) (point-max)))
2539                   #'string-lessp))))
2540   ;; State is preserved upon deleting a column.
2541   (should
2542    (equal '("a" "c")
2543           (org-test-with-temp-text "| a | <point>b | c |"
2544             (org-table-toggle-column-width "-")
2545             (org-table-delete-column)
2546             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2547                           (overlays-in (point-min) (point-max)))
2548                   #'string-lessp))))
2549   ;; State is preserved upon deleting a row.
2550   (should
2551    (equal '("b1" "b2")
2552           (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
2553             (org-table-toggle-column-width "-")
2554             (org-table-kill-row)
2555             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2556                           (overlays-in (point-min) (point-max)))
2557                   #'string-lessp))))
2558   (should
2559    (equal '("a1" "a2")
2560           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2561             (org-table-toggle-column-width "-")
2562             (org-table-kill-row)
2563             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2564                           (overlays-in (point-min) (point-max)))
2565                   #'string-lessp))))
2566   ;; State is preserved upon inserting a row or hline.
2567   (should
2568    (equal '("" "a1" "b1")
2569           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2570             (org-table-toggle-column-width)
2571             (org-table-insert-row)
2572             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2573                           (overlays-in (point-min) (point-max)))
2574                   #'string-lessp))))
2575   (should
2576    (equal '("a1" "b1")
2577           (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2578             (org-table-toggle-column-width)
2579             (org-table-insert-hline)
2580             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2581                           (overlays-in (point-min) (point-max)))
2582                   #'string-lessp))))
2583   ;; State is preserved upon sorting a column for all the columns but
2584   ;; the one being sorted.
2585   (should
2586    (equal '("a2" "b2")
2587           (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
2588             (org-table-toggle-column-width "-")
2589             (org-table-sort-lines nil ?A)
2590             (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2591                           (overlays-in (point-min) (point-max)))
2592                   #'string-lessp))))
2593   ;; State is preserved upon replacing a field non-interactively.
2594   (should
2595    (equal '("a")
2596           (org-test-with-temp-text "| <point>a |"
2597             (org-table-toggle-column-width)
2598             (org-table-get-field nil "b")
2599             (mapcar (lambda (o) (overlay-get o 'help-echo))
2600                     (overlays-in (point-min) (point-max)))))))
2601
2602
2603 \f
2604 ;;; Miscellaneous
2605
2606 (ert-deftest test-org-table/get-field ()
2607   "Test `org-table-get-field' specifications."
2608   ;; Regular test.
2609   (should
2610    (equal " a "
2611           (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
2612   ;; Get field in open last column.
2613   (should
2614    (equal " a "
2615           (org-test-with-temp-text "| <point>a " (org-table-get-field))))
2616   ;; Get empty field.
2617   (should
2618    (equal ""
2619           (org-test-with-temp-text "|<point>|" (org-table-get-field))))
2620   (should
2621    (equal " "
2622           (org-test-with-temp-text "| <point>|" (org-table-get-field))))
2623   ;; Outside the table, return the empty string.
2624   (should
2625    (equal ""
2626           (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
2627   (should
2628    (equal ""
2629           (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
2630   ;; With optional N argument, select a particular column in current
2631   ;; row.
2632   (should
2633    (equal " 3 "
2634           (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
2635   (should
2636    (equal " 4 "
2637           (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2638             (org-table-get-field 2))))
2639   ;; REPLACE optional argument is used to replace selected field.
2640   (should
2641    (equal "| foo |"
2642           (org-test-with-temp-text "| <point>1 |"
2643             (org-table-get-field nil " foo ")
2644             (buffer-string))))
2645   (should
2646    (equal "| 1 | 2 | foo |"
2647           (org-test-with-temp-text "| 1 | 2 | 3 |"
2648             (org-table-get-field 3 " foo ")
2649             (buffer-string))))
2650   (should
2651    (equal " 4 "
2652           (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2653             (org-table-get-field 2))))
2654   ;; An empty REPLACE string clears the field.
2655   (should
2656    (equal "| |"
2657           (org-test-with-temp-text "| <point>1 |"
2658             (org-table-get-field nil "")
2659             (buffer-string))))
2660   ;; When using REPLACE still return old value.
2661   (should
2662    (equal " 1 "
2663           (org-test-with-temp-text "| <point>1 |"
2664             (org-table-get-field nil " foo ")))))
2665
2666 (provide 'test-org-table)
2667
2668 ;;; test-org-table.el ends here