?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merge branch 'maint'
[org-mode.git] / testing / lisp / test-org-table.el
blob16edb264d4293d0d69e7c69ae1903de534849dc0
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 (ert-deftest test-org-table/align ()
158 "Align columns within Org buffer, depends on `org-table-number-regexp'."
159 (org-test-table-target-expect "
160 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
161 | ab | 12 | 12.2 | 2.4e-08 | 2x10^12 | 4.034+-0.02 | 2.7(10) | >3.5 |
162 | ab | ab | ab | ab | ab | ab | ab | ab |
163 ")
164 (org-test-table-target-expect "
165 | 0 | 0 | 0 | 0 | 0 | 0 |
166 | <-0x0ab.cf | >-36#0vw.yz | nan | uinf | -inf | inf |
167 | ab | ab | ab | ab | ab | ab |
168 "))
169
170 (ert-deftest test-org-table/align-buffer-tables ()
171 "Align all tables when updating buffer."
172 (let ((before "
173 | a b |
174
175 | c d |
176 ")
177 (after "
178 | a b |
179
180 | c d |
181 "))
182 (should (equal (org-test-with-temp-text before
183 (org-table-recalculate-buffer-tables)
184 (buffer-string))
185 after))
186 (should (equal (org-test-with-temp-text before
187 (org-table-iterate-buffer-tables)
188 (buffer-string))
189 after))))
190
191 (defconst references/target-normal "
192 | 0 | 1 | replace | replace | replace | replace | replace | replace |
193 | z | 1 | replace | replace | replace | replace | replace | replace |
194 | | 1 | replace | replace | replace | replace | replace | replace |
195 | | | replace | replace | replace | replace | replace | replace |
196 "
197 "Normal numbers and non-numbers for Lisp and Calc formula.")
198
199 (defconst references/target-special "
200 | nan | 1 | replace | replace | replace | replace | replace | replace |
201 | uinf | 1 | replace | replace | replace | replace | replace | replace |
202 | -inf | 1 | replace | replace | replace | replace | replace | replace |
203 | inf | 1 | replace | replace | replace | replace | replace | replace |
204 "
205 "Special numbers for Calc formula.")
206
207 (ert-deftest test-org-table/references/mode-string-EL ()
208 "Basic: Assign field reference, sum of field references, sum
209 and len of simple range reference (no row) and complex range
210 reference (with row). Mode string EL."
211 ;; Empty fields are kept during parsing field but lost as list
212 ;; elements within Lisp formula syntactically when used literally
213 ;; and not enclosed with " within fields, see last columns with len.
214 (org-test-table-target-expect
215 references/target-normal
216 ;; All the #ERROR show that for Lisp calculations N has to be used.
217 "
218 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
219 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
220 | | 1 | | 1 | 1 | 1 | 1 | 1 |
221 | | | | 0 | 0 | 0 | 0 | 0 |
222 "
223 1 (concat
224 "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
225 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
226 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
227
228 ;; Empty fields are kept during parsing field _and_ as list elements
229 ;; within Lisp formula syntactically even when used literally when
230 ;; enclosed with " within fields, see last columns with len.
231 (org-test-table-target-expect
232 "
233 | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
234 | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
235 | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
236 | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
237 "
238 "
239 | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
240 | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
241 | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
242 | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
243 "
244 1 (concat
245 "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
246 "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
247 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
248 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
249
250 (ert-deftest test-org-table/references/mode-string-E ()
251 "Basic: Assign field reference, sum of field references, sum
252 and len of simple range reference (no row) and complex range
253 reference (with row). Mode string E."
254 (let ((lisp
255 (concat
256 "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
257 "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
258 "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
259 (calc
260 (concat
261 "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
262 "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
263 "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
264 (org-test-table-target-expect
265 references/target-normal
266 ;; All the #ERROR show that for Lisp calculations N has to be used.
267 "
268 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
269 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
270 | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
271 | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
272 "
273 1 lisp)
274 (org-test-table-target-expect
275 references/target-normal
276 "
277 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
278 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
279 | | 1 | nan | nan | nan | nan | 2 | 2 |
280 | | | nan | nan | nan | nan | 2 | 2 |
281 "
282 1 calc)
283 (org-test-table-target-expect
284 references/target-special
285 "
286 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
287 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
288 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
289 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
290 "
291 1 calc)))
292
293 (ert-deftest test-org-table/references/mode-string-EN ()
294 "Basic: Assign field reference, sum of field references, sum
295 and len of simple range reference (no row) and complex range
296 reference (with row). Mode string EN."
297 (let ((lisp (concat
298 "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
299 "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
300 "$7 = '(length '($1..$2)); EN :: "
301 "$8 = '(length '(@0$1..@0$2)); EN"))
302 (calc (concat
303 "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
304 "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
305 "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
306 (org-test-table-target-expect
307 references/target-normal
308 "
309 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
310 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
311 | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
312 | | | 0 | 0 | 0 | 0 | 2 | 2 |
313 "
314 1 lisp calc)
315 (org-test-table-target-expect
316 references/target-special
317 "
318 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
319 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
320 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
321 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
322 "
323 1 calc)))
324
325 (ert-deftest test-org-table/references/mode-string-L ()
326 "Basic: Assign field reference, sum of field references, sum
327 and len of simple range reference (no row) and complex range
328 reference (with row). Mode string L."
329 (org-test-table-target-expect
330 references/target-normal
331 ;; All the #ERROR show that for Lisp calculations N has to be used.
332 "
333 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
334 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
335 | | 1 | | 1 | 1 | 1 | 1 | 1 |
336 | | | | 0 | 0 | 0 | 0 | 0 |
337 "
338 1 (concat
339 "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
340 "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
341 "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
342
343 (ert-deftest test-org-table/references/mode-string-none ()
344 "Basic: Assign field reference, sum of field references, sum
345 and len of simple range reference (no row) and complex range
346 reference (with row). No mode string."
347 (let ((lisp (concat
348 "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
349 "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
350 "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
351 (calc (concat
352 "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
353 "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
354 "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
355 (org-test-table-target-expect
356 references/target-normal
357 ;; All the #ERROR show that for Lisp calculations N has to be used.
358 "
359 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
360 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
361 | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
362 | | | | #ERROR | 0 | 0 | 0 | 0 |
363 "
364 1 lisp)
365 (org-test-table-target-expect
366 references/target-normal
367 "
368 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
369 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
370 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
371 | | | 0 | 0 | 0 | 0 | 0 | 0 |
372 "
373 1 calc)
374 (org-test-table-target-expect
375 references/target-special
376 "
377 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
378 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
379 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
380 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
381 "
382 1 calc)))
383
384 (ert-deftest test-org-table/references/mode-string-N ()
385 "Basic: Assign field reference, sum of field references, sum
386 and len of simple range reference (no row) and complex range
387 reference (with row). Mode string N."
388 (let ((lisp
389 (concat
390 "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
391 "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
392 "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
393 (calc
394 (concat
395 "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
396 "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
397 "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
398 (org-test-table-target-expect
399 references/target-normal
400 "
401 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
402 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
403 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
404 | | | 0 | 0 | 0 | 0 | 0 | 0 |
405 "
406 1 lisp calc)
407 (org-test-table-target-expect
408 references/target-special
409 "
410 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
411 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
412 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
413 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
414 "
415 1 calc)))
416
417 (ert-deftest test-org-table/lisp-return-value ()
418 "Basic: Return value of Lisp formulas."
419 (org-test-table-target-expect
420 "
421 | | nil | (list) | '() |
422 |-------------------------+-------------+--------+-----|
423 | type-of, no L | replace (r) | r | r |
424 | type-of identity, no L | r | r | r |
425 | identity, no L | r | r | r |
426 |-------------------------+-------------+--------+-----|
427 | type-of \"@1\" | r | r | r |
428 | type-of (identity \"@1\") | r | r | r |
429 | identity \"@1\" | r | r | r |
430 |-------------------------+-------------+--------+-----|
431 | type-of @1 | r | r | r |
432 | type-of (identity @1) | r | r | r |
433 | identity @1 | r | r | r |
434 "
435 "
436 | | nil | (list) | '() |
437 |-------------------------+--------+--------+--------|
438 | type-of, no L | string | string | string |
439 | type-of identity, no L | string | string | string |
440 | identity, no L | nil | (list) | '() |
441 |-------------------------+--------+--------+--------|
442 | type-of \"@1\" | string | string | string |
443 | type-of (identity \"@1\") | string | string | string |
444 | identity \"@1\" | nil | (list) | '() |
445 |-------------------------+--------+--------+--------|
446 | type-of @1 | symbol | symbol | symbol |
447 | type-of (identity @1) | symbol | symbol | symbol |
448 | identity @1 | nil | nil | nil |
449 "
450 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
451 "@3$<<..@3$> = '(type-of (identity @1)) :: "
452 "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
453
454 (ert-deftest test-org-table/compare ()
455 "Basic: Compare field references in Calc."
456 (org-test-table-target-expect
457 "
458 | | 0 | z | | nan | uinf | -inf | inf |
459 |------+------+------+------+------+------+------+------|
460 | 0 | repl | repl | repl | repl | repl | repl | repl |
461 | z | repl | repl | repl | repl | repl | repl | repl |
462 | | repl | repl | repl | repl | repl | repl | repl |
463 | nan | repl | repl | repl | repl | repl | repl | repl |
464 | uinf | repl | repl | repl | repl | repl | repl | repl |
465 | -inf | repl | repl | repl | repl | repl | repl | repl |
466 | inf | repl | repl | repl | repl | repl | repl | repl |
467 "
468 "
469 | | 0 | z | | nan | uinf | -inf | inf |
470 |------+---+---+---+-----+------+------+-----|
471 | 0 | x | | | | | | |
472 | z | | x | | | | | |
473 | | | | x | | | | |
474 | nan | | | | x | | | |
475 | uinf | | | | | x | | |
476 | -inf | | | | | | x | |
477 | inf | | | | | | | x |
478 "
479 1
480 ;; Compare field reference ($1) with field reference (@1)
481 "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
482 ;; Compare field reference ($1) with absolute term
483 (concat "#+TBLFM: "
484 "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
485 "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
486 "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
487 "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
488 "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
489 "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
490 "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
491
492 ;; Check field reference converted from an empty field: Despite this
493 ;; field reference will not end up in a result, Calc evaluates it.
494 ;; Make sure that also then there is no Calc error.
495 (org-test-table-target-expect
496 "
497 | 0 | replace |
498 | z | replace |
499 | | replace |
500 | nan | replace |
501 "
502 "
503 | 0 | 1 |
504 | z | z + 1 |
505 | | |
506 | nan | nan |
507 "
508 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
509
510 (ert-deftest test-org-table/empty-field ()
511 "Examples how to deal with empty fields."
512 ;; Test if one field is empty, else do a calculation
513 (org-test-table-target-expect
514 "
515 | -1 | replace |
516 | 0 | replace |
517 | | replace |
518 "
519 "
520 | -1 | 0 |
521 | 0 | 1 |
522 | | |
523 "
524 1
525 ;; Calc formula
526 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
527 ;; Lisp formula
528 "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
529
530 ;; Test if several fields are empty, else do a calculation
531 (org-test-table-target-expect
532 "
533 | 1 | 2 | replace |
534 | 4 | | replace |
535 | | 8 | replace |
536 | | | replace |
537 "
538 "
539 | 1 | 2 | 3 |
540 | 4 | | |
541 | | 8 | |
542 | | | |
543 "
544 1
545 ;; Calc formula
546 (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
547 "string(\"\"), $1 + $2); E")
548 ;; Lisp formula
549 (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
550 "\"\" (+ $1 $2)); L"))
551
552 ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
553 (org-test-table-target-expect
554 "
555 | 1.5 | 0 |
556 | 3.5 | |
557 | | 5 |
558 | | |
559 "
560 "
561 | 1.5 | 2.0 |
562 | 3.5 | 4.0 |
563 | | 5.0 |
564 | | |
565 "
566 1
567 ;; Calc formula
568 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
569 "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
570 ;; Lisp formula not implemented yet
571 )
572
573 ;; Empty fields in simple and complex range reference
574 (org-test-table-target-expect
575 "
576 | | | | | repl | repl | repl | repl | repl | repl |
577 | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
578 | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
579 "
580 "
581 | | | | | | | | | 0 | 0 |
582 | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
583 | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
584 "
585 1
586 ;; Calc formula
587 (concat
588 "#+TBLFM: "
589 "$5 = if(typeof(vmean($1..$4)) == 12, "
590 "string(\"\"), vmean($1..$4)); E :: "
591 "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
592 "string(\"\"), vmean(@0$1..@0$4)); E :: "
593 "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
594 "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
595 "$9 = vmean($1..$4); EN :: "
596 "$10 = vmean(@0$1..@0$4); EN")
597 ;; Lisp formula
598 (concat
599 "#+TBLFM: "
600 "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
601 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
602 "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
603 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
604 "$7 = '(let ((l '($1..$4))) "
605 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
606 "$8 = '(let ((l '(@0$1..@0$4))) "
607 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
608 "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
609 "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")
610 ))
611
612 (ert-deftest test-org-table/copy-field ()
613 "Experiments on how to copy one field into another field.
614 See also `test-org-table/remote-reference-access'."
615 (let ((target "
616 | 0 | replace |
617 | a b | replace |
618 | c d | replace |
619 | | replace |
620 | 2012-12 | replace |
621 | [2012-12-31 Mon] | replace |
622 "))
623 ;; Lisp formula to copy literally
624 (org-test-table-target-expect
625 target
626 "
627 | 0 | 0 |
628 | a b | a b |
629 | c d | c d |
630 | | |
631 | 2012-12 | 2012-12 |
632 | [2012-12-31 Mon] | [2012-12-31 Mon] |
633 "
634 1 "#+TBLFM: $2 = '(identity $1)")
635
636 ;; Calc formula to copy quite literally
637 (org-test-table-target-expect
638 target
639 "
640 | 0 | 0 |
641 | a b | a b |
642 | c d | c d |
643 | | |
644 | 2012-12 | 2012-12 |
645 | [2012-12-31 Mon] | <2012-12-31 Mon> |
646 "
647 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
648 "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
649
650 ;; Calc formula simple
651 (org-test-table-target-expect
652 target
653 "
654 | 0 | 0 |
655 | a b | a b |
656 | c d | c d |
657 | | |
658 | 2012-12 | 2000 |
659 | [2012-12-31 Mon] | <2012-12-31 Mon> |
660 "
661 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
662
663 (ert-deftest test-org-table/sub-total ()
664 "Grouped rows with sub-total.
665 Begin range with \"@II\" to handle multiline header. Convert
666 integer to float with \"+.0\" for sub-total of items c1 and c2.
667 Sum empty fields as value zero but without ignoring them for
668 \"vlen\" with format specifier \"EN\". Format possibly empty
669 results with the Calc formatter \"f-1\" instead of the printf
670 formatter \"%.1f\"."
671 (org-test-table-target-expect
672 "
673 |-------+---------+---------|
674 | Item | Item | Sub- |
675 | name | value | total |
676 |-------+---------+---------|
677 | a1 | 4.1 | replace |
678 | a2 | 8.2 | replace |
679 | a3 | | replace |
680 |-------+---------+---------|
681 | b1 | 16.0 | replace |
682 |-------+---------+---------|
683 | c1 | 32 | replace |
684 | c2 | 64 | replace |
685 |-------+---------+---------|
686 | Total | replace | replace |
687 |-------+---------+---------|
688 "
689 "
690 |-------+-------+-------|
691 | Item | Item | Sub- |
692 | name | value | total |
693 |-------+-------+-------|
694 | a1 | 4.1 | |
695 | a2 | 8.2 | |
696 | a3 | | 12.3 |
697 |-------+-------+-------|
698 | b1 | 16.0 | 16.0 |
699 |-------+-------+-------|
700 | c1 | 32 | |
701 | c2 | 64 | 96.0 |
702 |-------+-------+-------|
703 | Total | 124.3 | |
704 |-------+-------+-------|
705 "
706 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
707 "$3 = if(vlen(@0..@+I) == 1, "
708 "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
709 "@>$3 = string(\"\")")))
710
711 (ert-deftest test-org-table/org-lookup-all ()
712 "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
713 See also http://orgmode.org/worg/org-tutorials/org-lookups.html ."
714 (let ((data "
715 #+NAME: data
716 | Purchase | Product | Shop | Rating |
717 |----------+---------+------+--------|
718 | a | p1 | s1 | 1 |
719 | b | p1 | s2 | 4 |
720 | c | p2 | s1 | 2 |
721 | d | p3 | s2 | 8 |
722 "))
723
724 ;; Product rating and ranking by average purchase from "#+NAME: data"
725 (org-test-table-target-expect
726 (concat data "
727 | Product | Rating | Ranking |
728 |---------+---------+---------|
729 | p1 | replace | replace |
730 | p2 | replace | replace |
731 | p3 | replace | replace |
732 ")
733 (concat data "
734 | Product | Rating | Ranking |
735 |---------+--------+---------|
736 | p1 | 2.5 | 2 |
737 | p2 | 2.0 | 3 |
738 | p3 | 8.0 | 1 |
739 ")
740 2 (concat
741 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
742 "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
743 "(/ (apply '+ all) (length all) 1.0)); L :: "
744 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
745
746 ;; Shop rating and ranking by average purchase from "#+NAME: data"
747 (org-test-table-target-expect
748 (concat data "
749 | Shop | Rating | Ranking |
750 |------+---------+---------|
751 | s1 | replace | replace |
752 | s2 | replace | replace |
753 ")
754 (concat data "
755 | Shop | Rating | Ranking |
756 |------+--------+---------|
757 | s1 | 1.5 | 2 |
758 | s2 | 6.0 | 1 |
759 ")
760 2 (concat
761 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
762 "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
763 "(/ (apply '+ all) (length all) 1.0)); L :: "
764 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
765
766 (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
767 (fset 'f 'org-table-make-reference)
768 ;; For Lisp formula only
769 (should (equal "0" (f "0" t nil 'literal)))
770 (should (equal "z" (f "z" t nil 'literal)))
771 (should (equal "" (f "" t nil 'literal)))
772 (should (equal "0 1" (f '("0" "1") t nil 'literal)))
773 (should (equal "z 1" (f '("z" "1") t nil 'literal)))
774 (should (equal " 1" (f '("" "1") t nil 'literal)))
775 (should (equal " " (f '("" "" ) t nil 'literal))))
776
777 (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
778 (fset 'f 'org-table-make-reference)
779 ;; For Lisp formula
780 (should (equal "\"0\"" (f "0" t nil t)))
781 (should (equal "\"z\"" (f "z" t nil t)))
782 (should (equal "\"\"" (f "" t nil t)))
783 (should (equal "\"0\" \"1\"" (f '("0" "1") t nil t)))
784 (should (equal "\"z\" \"1\"" (f '("z" "1") t nil t)))
785 (should (equal "\"\" \"1\"" (f '("" "1") t nil t)))
786 (should (equal "\"\" \"\"" (f '("" "" ) t nil t)))
787 ;; For Calc formula
788 (should (equal "(0)" (f "0" t nil nil)))
789 (should (equal "(z)" (f "z" t nil nil)))
790 (should (equal "nan" (f "" t nil nil)))
791 (should (equal "[0,1]" (f '("0" "1") t nil nil)))
792 (should (equal "[z,1]" (f '("z" "1") t nil nil)))
793 (should (equal "[nan,1]" (f '("" "1") t nil nil)))
794 (should (equal "[nan,nan]" (f '("" "" ) t nil nil)))
795 ;; For Calc formula, special numbers
796 (should (equal "(nan)" (f "nan" t nil nil)))
797 (should (equal "(uinf)" (f "uinf" t nil nil)))
798 (should (equal "(-inf)" (f "-inf" t nil nil)))
799 (should (equal "(inf)" (f "inf" t nil nil)))
800 (should (equal "[nan,1]" (f '( "nan" "1") t nil nil)))
801 (should (equal "[uinf,1]" (f '("uinf" "1") t nil nil)))
802 (should (equal "[-inf,1]" (f '("-inf" "1") t nil nil)))
803 (should (equal "[inf,1]" (f '( "inf" "1") t nil nil))))
804
805 (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
806 (fset 'f 'org-table-make-reference)
807 ;; For Lisp formula
808 (should (equal "0" (f "0" t t t)))
809 (should (equal "0" (f "z" t t t)))
810 (should (equal "0" (f "" t t t)))
811 (should (equal "0 1" (f '("0" "1") t t t)))
812 (should (equal "0 1" (f '("z" "1") t t t)))
813 (should (equal "0 1" (f '("" "1") t t t)))
814 (should (equal "0 0" (f '("" "" ) t t t)))
815 ;; For Calc formula
816 (should (equal "(0)" (f "0" t t nil)))
817 (should (equal "(0)" (f "z" t t nil)))
818 (should (equal "(0)" (f "" t t nil)))
819 (should (equal "[0,1]" (f '("0" "1") t t nil)))
820 (should (equal "[0,1]" (f '("z" "1") t t nil)))
821 (should (equal "[0,1]" (f '("" "1") t t nil)))
822 (should (equal "[0,0]" (f '("" "" ) t t nil)))
823 ;; For Calc formula, special numbers
824 (should (equal "(0)" (f "nan" t t nil)))
825 (should (equal "(0)" (f "uinf" t t nil)))
826 (should (equal "(0)" (f "-inf" t t nil)))
827 (should (equal "(0)" (f "inf" t t nil)))
828 (should (equal "[0,1]" (f '( "nan" "1") t t nil)))
829 (should (equal "[0,1]" (f '("uinf" "1") t t nil)))
830 (should (equal "[0,1]" (f '("-inf" "1") t t nil)))
831 (should (equal "[0,1]" (f '( "inf" "1") t t nil))))
832
833 (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
834 (fset 'f 'org-table-make-reference)
835 ;; For Lisp formula only
836 (should (equal "0" (f "0" nil nil 'literal)))
837 (should (equal "z" (f "z" nil nil 'literal)))
838 (should (equal "" (f "" nil nil 'literal)))
839 (should (equal "0 1" (f '("0" "1") nil nil 'literal)))
840 (should (equal "z 1" (f '("z" "1") nil nil 'literal)))
841 (should (equal "1" (f '("" "1") nil nil 'literal)))
842 (should (equal "" (f '("" "" ) nil nil 'literal))))
843
844 (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
845 (fset 'f 'org-table-make-reference)
846 ;; For Lisp formula
847 (should (equal "\"0\"" (f "0" nil nil t)))
848 (should (equal "\"z\"" (f "z" nil nil t)))
849 (should (equal "" (f "" nil nil t)))
850 (should (equal "\"0\" \"1\"" (f '("0" "1") nil nil t)))
851 (should (equal "\"z\" \"1\"" (f '("z" "1") nil nil t)))
852 (should (equal "\"1\"" (f '("" "1") nil nil t)))
853 (should (equal "" (f '("" "" ) nil nil t)))
854 ;; For Calc formula
855 (should (equal "(0)" (f "0" nil nil nil)))
856 (should (equal "(z)" (f "z" nil nil nil)))
857 (should (equal "(0)" (f "" nil nil nil)))
858 (should (equal "[0,1]" (f '("0" "1") nil nil nil)))
859 (should (equal "[z,1]" (f '("z" "1") nil nil nil)))
860 (should (equal "[1]" (f '("" "1") nil nil nil)))
861 (should (equal "[]" (f '("" "" ) nil nil nil)))
862 ;; For Calc formula, special numbers
863 (should (equal "(nan)" (f "nan" nil nil nil)))
864 (should (equal "(uinf)" (f "uinf" nil nil nil)))
865 (should (equal "(-inf)" (f "-inf" nil nil nil)))
866 (should (equal "(inf)" (f "inf" nil nil nil)))
867 (should (equal "[nan,1]" (f '( "nan" "1") nil nil nil)))
868 (should (equal "[uinf,1]" (f '("uinf" "1") nil nil nil)))
869 (should (equal "[-inf,1]" (f '("-inf" "1") nil nil nil)))
870 (should (equal "[inf,1]" (f '( "inf" "1") nil nil nil))))
871
872 (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
873 (fset 'f 'org-table-make-reference)
874 ;; For Lisp formula
875 (should (equal "0" (f "0" nil t t)))
876 (should (equal "0" (f "z" nil t t)))
877 (should (equal "" (f "" nil t t)))
878 (should (equal "0 1" (f '("0" "1") nil t t)))
879 (should (equal "0 1" (f '("z" "1") nil t t)))
880 (should (equal "1" (f '("" "1") nil t t)))
881 (should (equal "" (f '("" "" ) nil t t)))
882 ;; For Calc formula
883 (should (equal "(0)" (f "0" nil t nil)))
884 (should (equal "(0)" (f "z" nil t nil)))
885 (should (equal "(0)" (f "" nil t nil)))
886 (should (equal "[0,1]" (f '("0" "1") nil t nil)))
887 (should (equal "[0,1]" (f '("z" "1") nil t nil)))
888 (should (equal "[1]" (f '("" "1") nil t nil)))
889 (should (equal "[]" (f '("" "" ) nil t nil)))
890 ;; For Calc formula, special numbers
891 (should (equal "(0)" (f "nan" nil t nil)))
892 (should (equal "(0)" (f "uinf" nil t nil)))
893 (should (equal "(0)" (f "-inf" nil t nil)))
894 (should (equal "(0)" (f "inf" nil t nil)))
895 (should (equal "[0,1]" (f '( "nan" "1") nil t nil)))
896 (should (equal "[0,1]" (f '("uinf" "1") nil t nil)))
897 (should (equal "[0,1]" (f '("-inf" "1") nil t nil)))
898 (should (equal "[0,1]" (f '( "inf" "1") nil t nil))))
899
900 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
901 "Simple reference @2$1."
902 (should
903 (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
904
905 ;; TODO: Test broken
906 ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
907 ;; "Self reference @1$1."
908 ;; (should
909 ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
910
911 (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
912 "Remote reference."
913 (should
914 (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
915
916 (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
917 "Simple reference @2$1."
918 (should
919 (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
920
921 (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
922 "Self reference $0."
923 (should
924 (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
925
926 ;; TODO: Test Broken
927 ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
928 ;; "Remote reference."
929 ;; (should
930 ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
931
932 (ert-deftest test-org-table/remote-reference-access ()
933 "Access to remote reference.
934 See also `test-org-table/copy-field'."
935 (org-test-table-target-expect
936 "
937 #+NAME: table
938 | | x 42 | |
939
940 | replace | replace |
941 "
942 "
943 #+NAME: table
944 | | x 42 | |
945
946 | x 42 | 84 x |
947 "
948 1 (concat "#+TBLFM: "
949 ;; Copy text without calculation: Use Lisp formula
950 "$1 = '(identity remote(table, @1$2)) :: "
951 ;; Do a calculation: Use Calc (or Lisp ) formula
952 "$2 = 2 * remote(table, @1$2)")))
953
954 (ert-deftest test-org-table/remote-reference-indirect ()
955 "Access to remote reference with indirection of name or ID."
956 (let ((source-tables "
957 #+NAME: 2012
958 | amount |
959 |--------|
960 | 1 |
961 | 2 |
962 |--------|
963 | 3 |
964 #+TBLFM: @>$1 = vsum(@I..@II)
965
966 #+NAME: 2013
967 | amount |
968 |--------|
969 | 4 |
970 | 8 |
971 |--------|
972 | 12 |
973 #+TBLFM: @>$1 = vsum(@I..@II)
974 "))
975
976 ;; Read several remote references from same column
977 (org-test-table-target-expect
978 (concat source-tables "
979 #+NAME: summary
980 | year | amount |
981 |-------+---------|
982 | 2012 | replace |
983 | 2013 | replace |
984 |-------+---------|
985 | total | replace |
986 ")
987 (concat source-tables "
988 #+NAME: summary
989 | year | amount |
990 |-------+--------|
991 | 2012 | 3 |
992 | 2013 | 12 |
993 |-------+--------|
994 | total | 15 |
995 ")
996 1
997 ;; Calc formula
998 "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
999 ;; Lisp formula
1000 (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
1001 "@>$2 = '(+ @I..@II); N"))
1002
1003 ;; Read several remote references from same row
1004 (org-test-table-target-expect
1005 (concat source-tables "
1006 #+NAME: summary
1007 | year | 2012 | 2013 | total |
1008 |--------+---------+---------+---------|
1009 | amount | replace | replace | replace |
1010 ")
1011 (concat source-tables "
1012 #+NAME: summary
1013 | year | 2012 | 2013 | total |
1014 |--------+------+------+-------|
1015 | amount | 3 | 12 | 15 |
1016 ")
1017 1
1018 ;; Calc formula
1019 "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
1020 ;; Lisp formula
1021 (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
1022 "@2$> = '(+ $<<..$>>); N"))))
1023
1024 (ert-deftest test-org-table/org-at-TBLFM-p ()
1025 (org-test-with-temp-text-in-file
1026 "
1027 | 1 |
1028 | 2 |
1029 #+TBLFM: $2=$1*2
1030
1031 "
1032 (goto-char (point-min))
1033 (forward-line 2)
1034 (should (equal (org-at-TBLFM-p) nil))
1035
1036 (goto-char (point-min))
1037 (forward-line 3)
1038 (should (equal (org-at-TBLFM-p) t))
1039
1040 (goto-char (point-min))
1041 (forward-line 4)
1042 (should (equal (org-at-TBLFM-p) nil))))
1043
1044 (ert-deftest test-org-table/org-table-TBLFM-begin ()
1045 (org-test-with-temp-text-in-file
1046 "
1047 | 1 |
1048 | 2 |
1049 #+TBLFM: $2=$1*2
1050
1051 "
1052 (goto-char (point-min))
1053 (should (equal (org-table-TBLFM-begin)
1054 nil))
1055
1056 (goto-char (point-min))
1057 (forward-line 1)
1058 (should (equal (org-table-TBLFM-begin)
1059 nil))
1060
1061 (goto-char (point-min))
1062 (forward-line 3)
1063 (should (= (org-table-TBLFM-begin)
1064 14))
1065
1066 (goto-char (point-min))
1067 (forward-line 4)
1068 (should (= (org-table-TBLFM-begin)
1069 14))
1070
1071 ))
1072
1073 (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
1074 "For multiple #+TBLFM lines."
1075 (org-test-with-temp-text-in-file
1076 "
1077 | 1 |
1078 | 2 |
1079 #+TBLFM: $2=$1*1
1080 #+TBLFM: $2=$1*2
1081
1082 "
1083 (goto-char (point-min))
1084 (should (equal (org-table-TBLFM-begin)
1085 nil))
1086
1087 (goto-char (point-min))
1088 (forward-line 1)
1089 (should (equal (org-table-TBLFM-begin)
1090 nil))
1091
1092 (goto-char (point-min))
1093 (forward-line 3)
1094 (should (= (org-table-TBLFM-begin)
1095 14))
1096
1097 (goto-char (point-min))
1098 (forward-line 4)
1099 (should (= (org-table-TBLFM-begin)
1100 14))
1101
1102 (goto-char (point-min))
1103 (forward-line 5)
1104 (should (= (org-table-TBLFM-begin)
1105 14))
1106
1107 ))
1108
1109 (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
1110 (org-test-with-temp-text-in-file
1111 "
1112 | 1 |
1113 | 2 |
1114 #+TBLFM: $2=$1*1
1115 #+TBLFM: $2=$1*2
1116
1117 | 6 |
1118 | 7 |
1119 #+TBLFM: $2=$1*1
1120 #+TBLFM: $2=$1*2
1121
1122 "
1123 (goto-char (point-min))
1124 (should (equal (org-table-TBLFM-begin)
1125 nil))
1126
1127 (goto-char (point-min))
1128 (forward-line 1)
1129 (should (equal (org-table-TBLFM-begin)
1130 nil))
1131
1132 (goto-char (point-min))
1133 (forward-line 3)
1134 (should (= (org-table-TBLFM-begin)
1135 14))
1136
1137 (goto-char (point-min))
1138 (forward-line 4)
1139 (should (= (org-table-TBLFM-begin)
1140 14))
1141
1142 (goto-char (point-min))
1143 (forward-line 5)
1144 (should (= (org-table-TBLFM-begin)
1145 14))
1146
1147 (goto-char (point-min))
1148 (forward-line 6)
1149 (should (= (org-table-TBLFM-begin)
1150 14))
1151
1152 (goto-char (point-min))
1153 (forward-line 8)
1154 (should (= (org-table-TBLFM-begin)
1155 61))
1156
1157 (goto-char (point-min))
1158 (forward-line 9)
1159 (should (= (org-table-TBLFM-begin)
1160 61))
1161
1162 (goto-char (point-min))
1163 (forward-line 10)
1164 (should (= (org-table-TBLFM-begin)
1165 61))))
1166
1167 (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
1168 (org-test-with-temp-text-in-file
1169 "
1170 | 1 | |
1171 | 2 | |
1172 #+TBLFM: $2=$1*1
1173 #+TBLFM: $2=$1*2
1174 #+TBLFM: $2=$1*3
1175 "
1176 (let ((got (progn (goto-char (point-min))
1177 (forward-line 3)
1178 (org-table-calc-current-TBLFM)
1179 (buffer-string)))
1180 (expect "
1181 | 1 | 1 |
1182 | 2 | 2 |
1183 #+TBLFM: $2=$1*1
1184 #+TBLFM: $2=$1*2
1185 #+TBLFM: $2=$1*3
1186 "))
1187 (should (string= got
1188 expect)))
1189
1190 (let ((got (progn (goto-char (point-min))
1191 (forward-line 4)
1192 (org-table-calc-current-TBLFM)
1193 (buffer-string)))
1194 (expect "
1195 | 1 | 2 |
1196 | 2 | 4 |
1197 #+TBLFM: $2=$1*1
1198 #+TBLFM: $2=$1*2
1199 #+TBLFM: $2=$1*3
1200 "))
1201 (should (string= got
1202 expect)))))
1203
1204 (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
1205 "org-table-calc-current-TBLFM should preserve the input as it was."
1206 (org-test-with-temp-text-in-file
1207 "
1208 | 1 | 1 |
1209 | 2 | 2 |
1210 #+TBLFM: $2=$1*1
1211 #+TBLFM: $2=$1*2::$2=$1*2
1212 #+TBLFM: $2=$1*3
1213 "
1214 (let ((expect "
1215 | 1 | 1 |
1216 | 2 | 2 |
1217 #+TBLFM: $2=$1*1
1218 #+TBLFM: $2=$1*2::$2=$1*2
1219 #+TBLFM: $2=$1*3
1220 "))
1221 (goto-char (point-min))
1222 (forward-line 4)
1223 (should-error (org-table-calc-current-TBLFM))
1224 (setq got (buffer-string))
1225 (message "%s" got)
1226 (should (string= got
1227 expect)))))
1228
1229 ;;; Radio Tables
1230
1231 (ert-deftest test-org-table/to-generic ()
1232 "Test `orgtbl-to-generic' specifications."
1233 ;; Test :hline parameter.
1234 (should
1235 (equal "a\nb"
1236 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1237 '(:hline nil))))
1238 (should
1239 (equal "a\n~\nb"
1240 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1241 '(:hline "~"))))
1242 ;; Test :sep parameter.
1243 (should
1244 (equal "a!b\nc!d"
1245 (orgtbl-to-generic
1246 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1247 '(:sep "!"))))
1248 ;; Test :hsep parameter.
1249 (should
1250 (equal "a!b\nc?d"
1251 (orgtbl-to-generic
1252 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1253 '(:sep "?" :hsep "!"))))
1254 ;; Test :tstart parameter.
1255 (should
1256 (equal "<begin>\na"
1257 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
1258 (should
1259 (equal "<begin>\na"
1260 (orgtbl-to-generic (org-table-to-lisp "| a |")
1261 '(:tstart (lambda () "<begin>")))))
1262 (should
1263 (equal "a"
1264 (orgtbl-to-generic (org-table-to-lisp "| a |")
1265 '(:tstart "<begin>" :splice t))))
1266 ;; Test :tend parameter.
1267 (should
1268 (equal "a\n<end>"
1269 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
1270 (should
1271 (equal "a\n<end>"
1272 (orgtbl-to-generic (org-table-to-lisp "| a |")
1273 '(:tend (lambda () "<end>")))))
1274 (should
1275 (equal "a"
1276 (orgtbl-to-generic (org-table-to-lisp "| a |")
1277 '(:tend "<end>" :splice t))))
1278 ;; Test :lstart parameter.
1279 (should
1280 (equal "> a"
1281 (orgtbl-to-generic
1282 (org-table-to-lisp "| a |") '(:lstart "> "))))
1283 (should
1284 (equal "> a"
1285 (orgtbl-to-generic (org-table-to-lisp "| a |")
1286 '(:lstart (lambda () "> ")))))
1287 ;; Test :llstart parameter.
1288 (should
1289 (equal "> a\n>> b"
1290 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1291 '(:lstart "> " :llstart ">> "))))
1292 ;; Test :hlstart parameter.
1293 (should
1294 (equal "!> a\n> b"
1295 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1296 '(:lstart "> " :hlstart "!> "))))
1297 ;; Test :hllstart parameter.
1298 (should
1299 (equal "!> a\n!!> b\n> c"
1300 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1301 '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
1302 ;; Test :lend parameter.
1303 (should
1304 (equal "a <"
1305 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
1306 ;; Test :llend parameter.
1307 (should
1308 (equal "a <\nb <<"
1309 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1310 '(:lend " <" :llend " <<"))))
1311 ;; Test :hlend parameter.
1312 (should
1313 (equal "a <!\nb <"
1314 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1315 '(:lend " <" :hlend " <!"))))
1316 ;; Test :hllend parameter.
1317 (should
1318 (equal "a <!\nb <!!\nc <"
1319 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1320 '(:lend " <" :hlend " <!" :hllend " <!!"))))
1321 ;; Test :lfmt parameter.
1322 (should
1323 (equal "a!b"
1324 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1325 '(:lfmt "%s!%s"))))
1326 (should
1327 (equal "a+b"
1328 (orgtbl-to-generic
1329 (org-table-to-lisp "| a | b |")
1330 '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1331 (should
1332 (equal "a!b"
1333 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1334 '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1335 ;; Test :llfmt parameter.
1336 (should
1337 (equal "a!b"
1338 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1339 '(:llfmt "%s!%s"))))
1340 (should
1341 (equal "a!b\nc+d"
1342 (orgtbl-to-generic
1343 (org-table-to-lisp "| a | b |\n| c | d |")
1344 '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1345 (should
1346 (equal "a!b"
1347 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1348 '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1349 ;; Test :hlfmt parameter.
1350 (should
1351 (equal "a!b\ncd"
1352 (orgtbl-to-generic
1353 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1354 '(:hlfmt "%s!%s"))))
1355 (should
1356 (equal "a+b\ncd"
1357 (orgtbl-to-generic
1358 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1359 '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1360 (should
1361 (equal "a!b\n>c d<"
1362 (orgtbl-to-generic
1363 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1364 '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1365 ;; Test :hllfmt parameter.
1366 (should
1367 (equal "a!b\ncd"
1368 (orgtbl-to-generic
1369 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1370 '(:hllfmt "%s!%s"))))
1371 (should
1372 (equal "a+b\ncd"
1373 (orgtbl-to-generic
1374 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1375 '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1376 (should
1377 (equal "a!b\n>c d<"
1378 (orgtbl-to-generic
1379 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1380 '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1381 ;; Test :fmt parameter.
1382 (should
1383 (equal ">a<\n>b<"
1384 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1385 '(:fmt ">%s<"))))
1386 (should
1387 (equal ">a<b"
1388 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1389 '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
1390 (should
1391 (equal "a b"
1392 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1393 '(:fmt (2 " %s")))))
1394 (should
1395 (equal ">a<"
1396 (orgtbl-to-generic (org-table-to-lisp "| a |")
1397 '(:fmt (lambda (c) (format ">%s<" c))))))
1398 ;; Test :hfmt parameter.
1399 (should
1400 (equal ">a<\nb"
1401 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1402 '(:hfmt ">%s<"))))
1403 (should
1404 (equal ">a<b\ncd"
1405 (orgtbl-to-generic
1406 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1407 '(:hfmt (1 ">%s<" 2 identity)))))
1408 (should
1409 (equal "a b\ncd"
1410 (orgtbl-to-generic
1411 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1412 '(:hfmt (2 " %s")))))
1413 (should
1414 (equal ">a<\nb"
1415 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1416 '(:hfmt (lambda (c) (format ">%s<" c))))))
1417 ;; Test :efmt parameter.
1418 (should
1419 (equal "2x10^3"
1420 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1421 '(:efmt "%sx10^%s"))))
1422 (should
1423 (equal "2x10^3"
1424 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1425 '(:efmt (lambda (m e) (concat m "x10^" e))))))
1426 (should
1427 (equal "2x10^3"
1428 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1429 '(:efmt (1 "%sx10^%s")))))
1430 (should
1431 (equal "2x10^3"
1432 (orgtbl-to-generic
1433 (org-table-to-lisp "| 2e3 |")
1434 '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
1435 (should
1436 (equal "2e3"
1437 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
1438 ;; Test :skip parameter.
1439 (should
1440 (equal "cd"
1441 (orgtbl-to-generic
1442 (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
1443 '(:skip 2))))
1444 ;; Test :skipcols parameter.
1445 (should
1446 (equal "a\nc"
1447 (orgtbl-to-generic
1448 (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
1449 (should
1450 (equal "a\nc"
1451 (orgtbl-to-generic
1452 (org-table-to-lisp
1453 "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
1454 '(:skipcols (2)))))
1455 ;; Test :raw parameter.
1456 (when (featurep 'ox-latex)
1457 (should
1458 (string-match-p
1459 "/a/"
1460 (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
1461 '(:backend latex :raw t)))))
1462 ;; Hooks are ignored.
1463 (should
1464 (equal
1465 "a\nb"
1466 (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
1467 (org-export-before-parsing-hook fun-list)
1468 (org-export-before-processing-hook fun-list))
1469 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1470 '(:hline nil)))))
1471 ;; User-defined export filters are ignored.
1472 (should
1473 (equal
1474 "a\nb"
1475 (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
1476 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1477 '(:hline nil)))))
1478 ;; Macros, even if unknown, are returned as-is.
1479 (should
1480 (equal "{{{macro}}}"
1481 (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
1482
1483 (ert-deftest test-org-table/to-latex ()
1484 "Test `orgtbl-to-latex' specifications."
1485 (should
1486 (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
1487 (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
1488 ;; Test :environment parameter.
1489 (should
1490 (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
1491 (orgtbl-to-latex (org-table-to-lisp "| a |")
1492 '(:environment "tabularx"))))
1493 ;; Test :booktabs parameter.
1494 (should
1495 (string-match-p
1496 "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
1497 ;; Handle LaTeX snippets.
1498 (should
1499 (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
1500 (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
1501 ;; Test pseudo objects and :raw parameter.
1502 (should
1503 (string-match-p
1504 "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
1505
1506 (ert-deftest test-org-table/to-html ()
1507 "Test `orgtbl-to-html' specifications."
1508 (should
1509 (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
1510 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
1511
1512
1513 <colgroup>
1514 <col class=\"org-left\" />
1515 </colgroup>
1516 <tbody>
1517 <tr>
1518 <td class=\"org-left\">a</td>
1519 </tr>
1520 </tbody>
1521 </table>"))
1522 ;; Test :attributes parameter.
1523 (should
1524 (string-match-p
1525 "<table>"
1526 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
1527 (should
1528 (string-match-p
1529 "<table border=\"2\">"
1530 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
1531
1532 (ert-deftest test-org-table/to-texinfo ()
1533 "Test `orgtbl-to-texinfo' specifications."
1534 (should
1535 (equal "@multitable {a}\n@item a\n@end multitable"
1536 (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
1537 ;; Test :columns parameter.
1538 (should
1539 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1540 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1541 '(:columns ".4 .6"))))
1542 (should
1543 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1544 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1545 '(:columns "@columnfractions .4 .6"))))
1546 (should
1547 (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
1548 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1549 '(:columns "{xxx} {xx}")))))
1550
1551 (ert-deftest test-org-table/to-orgtbl ()
1552 "Test `orgtbl-to-orgtbl' specifications."
1553 (should
1554 (equal "| a | b |\n|---+---|\n| c | d |"
1555 (orgtbl-to-orgtbl
1556 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
1557
1558 (ert-deftest test-org-table/to-unicode ()
1559 "Test `orgtbl-to-unicode' specifications."
1560 (should
1561 (equal "━━━\n a \n━━━"
1562 (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
1563 ;; Test :narrow parameter.
1564 (should
1565 (equal "━━━━\n => \n━━━━"
1566 (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
1567 '(:narrow t)))))
1568
1569 (ert-deftest test-org-table/send-region ()
1570 "Test `orgtbl-send-table' specifications."
1571 ;; Error when not at a table.
1572 (should-error
1573 (org-test-with-temp-text "Paragraph"
1574 (orgtbl-send-table)))
1575 ;; Error when destination is missing.
1576 (should-error
1577 (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
1578 (orgtbl-send-table)))
1579 ;; Error when transformation function is not specified.
1580 (should-error
1581 (org-test-with-temp-text "
1582 # BEGIN RECEIVE ORGTBL table
1583 # END RECEIVE ORGTBL table
1584 #+ORGTBL: SEND table
1585 <point>| a |"
1586 (orgtbl-send-table)))
1587 ;; Standard test.
1588 (should
1589 (equal "| a |\n|---|\n| b |\n"
1590 (org-test-with-temp-text "
1591 # BEGIN RECEIVE ORGTBL table
1592 # END RECEIVE ORGTBL table
1593 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1594 <point>| a |\n|---|\n| b |"
1595 (orgtbl-send-table)
1596 (goto-char (point-min))
1597 (buffer-substring-no-properties
1598 (search-forward "# BEGIN RECEIVE ORGTBL table\n")
1599 (progn (search-forward "# END RECEIVE ORGTBL table")
1600 (match-beginning 0))))))
1601 ;; Allow multiple receiver locations.
1602 (should
1603 (org-test-with-temp-text "
1604 # BEGIN RECEIVE ORGTBL table
1605 # END RECEIVE ORGTBL table
1606
1607 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1608 <point>| a |
1609
1610 # BEGIN RECEIVE ORGTBL table
1611 # END RECEIVE ORGTBL table"
1612 (orgtbl-send-table)
1613 (goto-char (point-min))
1614 (search-forward "| a |" nil t 3))))
1615
1616 \f
1617 ;;; Sorting
1618
1619 (ert-deftest test-org-table/sort-lines ()
1620 "Test `org-table-sort-lines' specifications."
1621 ;; Sort numerically.
1622 (should
1623 (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
1624 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1625 (org-table-sort-lines nil ?n)
1626 (buffer-string))))
1627 (should
1628 (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
1629 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1630 (org-table-sort-lines nil ?N)
1631 (buffer-string))))
1632 ;; Sort alphabetically.
1633 (should
1634 (equal "| a | x |\n| b | 4 |\n| c | 3 |\n"
1635 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1636 (org-table-sort-lines nil ?a)
1637 (buffer-string))))
1638 (should
1639 (equal "| c | 3 |\n| b | 4 |\n| a | x |\n"
1640 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| b | 4 |\n"
1641 (org-table-sort-lines nil ?A)
1642 (buffer-string))))
1643 ;; Sort alphabetically with case.
1644 (should
1645 (equal "| C |\n| a |\n| b |\n"
1646 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1647 (org-table-sort-lines t ?a)
1648 (buffer-string))))
1649 (should
1650 (equal "| b |\n| a |\n| C |\n"
1651 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1652 (org-table-sort-lines nil ?A)
1653 (buffer-string))))
1654 ;; Sort by time (timestamps)
1655 (should
1656 (equal
1657 "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
1658 (org-test-with-temp-text
1659 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1660 (org-table-sort-lines nil ?t)
1661 (buffer-string))))
1662 (should
1663 (equal
1664 "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
1665 (org-test-with-temp-text
1666 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1667 (org-table-sort-lines nil ?T)
1668 (buffer-string))))
1669 ;; Sort by time (HH:MM values)
1670 (should
1671 (equal "| 1:00 |\n| 14:00 |\n| 17:00 |\n"
1672 (org-test-with-temp-text "| 14:00 |\n| 17:00 |\n| 1:00 |\n"
1673 (org-table-sort-lines nil ?t)
1674 (buffer-string))))
1675 (should
1676 (equal "| 17:00 |\n| 14:00 |\n| 1:00 |\n"
1677 (org-test-with-temp-text "| 14:00 |\n| 17:00 |\n| 1:00 |\n"
1678 (org-table-sort-lines nil ?T)
1679 (buffer-string))))
1680 ;; Sort with custom functions.
1681 (should
1682 (equal "| 22 |\n| 15 |\n| 18 |\n"
1683 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1684 (org-table-sort-lines nil ?f
1685 (lambda (s) (% (string-to-number s) 10))
1686 #'<)
1687 (buffer-string))))
1688 (should
1689 (equal "| 18 |\n| 15 |\n| 22 |\n"
1690 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1691 (org-table-sort-lines nil ?F
1692 (lambda (s) (% (string-to-number s) 10))
1693 #'<)
1694 (buffer-string))))
1695 ;; Sort according to current column.
1696 (should
1697 (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
1698 (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
1699 (org-table-sort-lines nil ?n)
1700 (buffer-string))))
1701 ;; Sort between horizontal separators if possible.
1702 (should
1703 (equal
1704 "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
1705 (org-test-with-temp-text
1706 "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
1707 (org-table-sort-lines nil ?n)
1708 (buffer-string)))))
1709
1710 \f
1711 ;;; Formulas
1712
1713 (ert-deftest test-org-table/eval-formula ()
1714 "Test `org-table-eval-formula' specifications."
1715 ;; Error when not on a table field.
1716 (should-error
1717 (org-test-with-temp-text "Text"
1718 (org-table-eval-formula)))
1719 (should-error
1720 (org-test-with-temp-text "| a |\n|---|<point>"
1721 (org-table-eval-formula)))
1722 (should-error
1723 (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
1724 (org-table-eval-formula)))
1725 ;; Handle @<, @>, $< and $>.
1726 (should
1727 (equal "| 1 |\n| 1 |"
1728 (org-test-with-temp-text "| <point> |\n| 1 |"
1729 (org-table-eval-formula nil "@>" nil nil t)
1730 (buffer-string))))
1731 (should
1732 (equal "| 1 |\n| 1 |"
1733 (org-test-with-temp-text "| 1 |\n| <point> |"
1734 (org-table-eval-formula nil "@<" nil nil t)
1735 (buffer-string))))
1736 (should
1737 (equal "| 1 | 1 |"
1738 (org-test-with-temp-text "| <point> | 1 |"
1739 (org-table-eval-formula nil "$>" nil nil t)
1740 (buffer-string))))
1741 (should
1742 (equal "| 1 | 1 |"
1743 (org-test-with-temp-text "| 1 | <point> |"
1744 (org-table-eval-formula nil "$<" nil nil t)
1745 (buffer-string)))))
1746
1747 (ert-deftest test-org-table/field-formula-outside-table ()
1748 "If `org-table-formula-create-columns' is nil, then a formula
1749 that references an out-of-bounds column should do nothing. If it
1750 is t, then new columns should be added as needed"
1751
1752 (let ((org-table-formula-create-columns nil))
1753
1754 (should-error
1755 (org-test-table-target-expect
1756 "
1757 | 2 |
1758 | 4 |
1759 | 8 |
1760 "
1761 "
1762 | 2 |
1763 | 4 |
1764 | 8 |
1765 "
1766 1
1767 "#+TBLFM: @1$2=5")
1768 :type (list 'error 'user-error)))
1769
1770 (let ((org-table-formula-create-columns t))
1771
1772 ;; make sure field formulas work
1773 (org-test-table-target-expect
1774 "
1775 | 2 |
1776 | 4 |
1777 | 8 |
1778 "
1779 "
1780 | 2 | 5 |
1781 | 4 | |
1782 | 8 | |
1783 "
1784 1
1785 "#+TBLFM: @1$2=5")
1786
1787 ;; and make sure column formulas work too
1788 (org-test-table-target-expect
1789 "
1790 | 2 |
1791 | 4 |
1792 | 8 |
1793 "
1794 "
1795 | 2 | | 15 |
1796 | 4 | | 15 |
1797 | 8 | | 15 |
1798 "
1799 1
1800 "#+TBLFM: $3=15")))
1801
1802 (ert-deftest test-org-table/duration ()
1803 "Test durations in table formulas."
1804 ;; Durations in cells.
1805 (should
1806 (string-match "| 2:12 | 1:47 | 03:59:00 |"
1807 (org-test-with-temp-text "
1808 | 2:12 | 1:47 | |
1809 <point>#+TBLFM: @1$3=$1+$2;T"
1810 (org-table-calc-current-TBLFM)
1811 (buffer-string))))
1812 (should
1813 (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
1814 (org-test-with-temp-text "
1815 | 3:02:20 | -2:07:00 | |
1816 <point>#+TBLFM: @1$3=$1+$2;t"
1817 (org-table-calc-current-TBLFM)
1818 (buffer-string))))
1819 ;; Durations set through properties.
1820 (should
1821 (string-match "| 16:00:00 |"
1822 (org-test-with-temp-text "* H
1823 :PROPERTIES:
1824 :time_constant: 08:00:00
1825 :END:
1826
1827 | |
1828 <point>#+TBLFM: $1=2*$PROP_time_constant;T"
1829 (org-table-calc-current-TBLFM)
1830 (buffer-string))))
1831 (should
1832 (string-match "| 16.00 |"
1833 (org-test-with-temp-text "* H
1834 :PROPERTIES:
1835 :time_constant: 08:00:00
1836 :END:
1837
1838 | |
1839 <point>#+TBLFM: $1=2*$PROP_time_constant;t"
1840 (org-table-calc-current-TBLFM)
1841 (buffer-string)))))
1842
1843 (ert-deftest test-org-table/end-on-hline ()
1844 "Test with a table ending on a hline."
1845 (should
1846 (equal
1847 (org-test-with-temp-text
1848 "
1849 | 1 | 2 | 3 |
1850 | 4 | 5 | 6 |
1851 | | | |
1852 |---+---+---|
1853 <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
1854 (org-table-calc-current-TBLFM)
1855 (buffer-string))
1856 "
1857 | 1 | 2 | 3 |
1858 | 4 | 5 | 6 |
1859 | | 7 | 9 |
1860 |---+---+---|
1861 #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
1862
1863 (ert-deftest test-org-table/named-field ()
1864 "Test formula with a named field."
1865 (should
1866 (string-match-p
1867 "| +| +1 +|"
1868 (org-test-with-temp-text "
1869 | | |
1870 | ^ | name |
1871 <point>#+TBLFM: $name=1"
1872 (org-table-calc-current-TBLFM)
1873 (buffer-string))))
1874 (should
1875 (string-match-p
1876 "| +| +1 +|"
1877 (org-test-with-temp-text "
1878 | _ | name |
1879 | | |
1880 <point>#+TBLFM: $name=1"
1881 (org-table-calc-current-TBLFM)
1882 (buffer-string)))))
1883
1884 (ert-deftest test-org-table/named-column ()
1885 "Test formula with a named field."
1886 (should
1887 (string-match-p
1888 "| +| +1 +| +1 +|"
1889 (org-test-with-temp-text "
1890 | ! | name | |
1891 | | 1 | |
1892 <point>#+TBLFM: @2$3=$name"
1893 (org-table-calc-current-TBLFM)
1894 (buffer-string)))))
1895
1896 (ert-deftest test-org-table/tab-indent ()
1897 "Test named fields with tab indentation."
1898 (should
1899 (string-match-p
1900 "| # | 111 |"
1901 (org-test-with-temp-text
1902 "
1903 | ! | sum | | a | b | c |
1904 |---+------+------+---+----+-----|
1905 | # | 1011 | 1000 | 1 | 10 | 100 |
1906 <point>#+TBLFM: $2=$a+$b+$c
1907 "
1908 (org-table-calc-current-TBLFM)
1909 (buffer-string)))))
1910
1911 (ert-deftest test-org-table/first-rc ()
1912 "Test \"$<\" and \"@<\" constructs in formulas."
1913 (should
1914 (string-match-p
1915 "| 1 | 2 |"
1916 (org-test-with-temp-text
1917 "| | 2 |
1918 <point>#+TBLFM: $<=1"
1919 (org-table-calc-current-TBLFM)
1920 (buffer-string))))
1921 (should
1922 (string-match-p
1923 "| 2 |\n| 2 |"
1924 (org-test-with-temp-text
1925 "| 2 |\n| |
1926 <point>#+TBLFM: @2$1=@<"
1927 (org-table-calc-current-TBLFM)
1928 (buffer-string)))))
1929
1930 (ert-deftest test-org-table/last-rc ()
1931 "Test \"$>\" and \"@>\" constructs in formulas."
1932 (should
1933 (string-match-p
1934 "| 2 | 1 |"
1935 (org-test-with-temp-text
1936 "| 2 | |\n<point>#+TBLFM: $>=1"
1937 (org-table-calc-current-TBLFM)
1938 (buffer-string))))
1939 (should
1940 (string-match-p
1941 "| 2 |\n| 2 |"
1942 (org-test-with-temp-text
1943 "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
1944 (org-table-calc-current-TBLFM)
1945 (buffer-string)))))
1946
1947 (ert-deftest test-org-table/time-stamps ()
1948 "Test time-stamps handling."
1949 ;; Standard test.
1950 (should
1951 (string-match-p
1952 "| 1 |"
1953 (org-test-with-temp-text
1954 "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
1955 (org-table-calc-current-TBLFM)
1956 (buffer-string))))
1957 ;; Handle locale specific time-stamps.
1958 (should
1959 (string-match-p
1960 "| 1 |"
1961 (org-test-with-temp-text
1962 "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
1963 (org-table-calc-current-TBLFM)
1964 (buffer-string)))))
1965
1966
1967 (ert-deftest test-org-table/orgtbl-ascii-draw ()
1968 "Test `orgtbl-ascii-draw'."
1969 ;; First value: Make sure that an integer input value is converted to a
1970 ;; float before division. Further values: Show some float input value
1971 ;; ranges corresponding to the same bar width.
1972 (should
1973 (equal
1974 (org-test-with-temp-text
1975 "
1976 | Value | <l> |
1977 |----------+---------|
1978 | 19 | replace |
1979 |----------+---------|
1980 | -0.50001 | replace |
1981 | -0.49999 | replace |
1982 | 0.49999 | replace |
1983 | 0.50001 | replace |
1984 | 1.49999 | replace |
1985 | 22.50001 | replace |
1986 | 23.49999 | replace |
1987 | 23.50001 | replace |
1988 | 24.49999 | replace |
1989 | 24.50001 | replace |
1990 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
1991 (org-table-calc-current-TBLFM)
1992 (buffer-string))
1993 "
1994 | Value | <l> |
1995 |----------+-----------|
1996 | 19 | 883 |
1997 |----------+-----------|
1998 | -0.50001 | too small |
1999 | -0.49999 | |
2000 | 0.49999 | |
2001 | 0.50001 | 1 |
2002 | 1.49999 | 1 |
2003 | 22.50001 | 887 |
2004 | 23.49999 | 887 |
2005 | 23.50001 | 888 |
2006 | 24.49999 | 888 |
2007 | 24.50001 | too large |
2008 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
2009 ;; Draw bars with a bullet. The bullet does not count in the parameter
2010 ;; WIDTH of `orgtbl-ascii-draw'.
2011 (should
2012 (equal
2013 (org-test-with-temp-text
2014 "
2015 | -1 | replace |
2016 | 0 | replace |
2017 | 1 | replace |
2018 | 2 | replace |
2019 | 3 | replace |
2020 | 4 | replace |
2021 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2022 (org-table-calc-current-TBLFM)
2023 (buffer-string))
2024 "
2025 | -1 | too small |
2026 | 0 | $ |
2027 | 1 | -$ |
2028 | 2 | --$ |
2029 | 3 | ---$ |
2030 | 4 | too large |
2031 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2032
2033 (ert-deftest test-org-table/single-rowgroup ()
2034 "Test column formula in a table with a single rowgroup."
2035 (should
2036 (equal
2037 "
2038 |---+---|
2039 | 1 | 0 |
2040 |---+---|
2041 #+TBLFM: $2=$1-1"
2042 (org-test-with-temp-text "
2043 |---+---|
2044 | 1 | |
2045 |---+---|
2046 <point>#+TBLFM: $2=$1-1"
2047 (org-table-calc-current-TBLFM)
2048 (buffer-string))))
2049 (should
2050 (equal
2051 "
2052 | 1 | 0 |
2053 #+TBLFM: $2=$1-1"
2054 (org-test-with-temp-text "
2055 | 1 | |
2056 <point>#+TBLFM: $2=$1-1"
2057 (org-table-calc-current-TBLFM)
2058 (buffer-string)))))
2059
2060 \f
2061 ;;; Navigation
2062
2063 (ert-deftest test-org-table/next-field ()
2064 "Test `org-table-next-field' specifications."
2065 ;; Regular test.
2066 (should
2067 (equal
2068 "b"
2069 (org-test-with-temp-text "| a<point> | b |"
2070 (org-table-next-field)
2071 (org-trim (org-table-get-field)))))
2072 ;; Create new rows as needed.
2073 (should
2074 (equal
2075 "| a |\n| |\n"
2076 (org-test-with-temp-text "| a<point> |"
2077 (org-table-next-field)
2078 (buffer-string))))
2079 ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
2080 ;; non-nil.
2081 (should
2082 (equal
2083 "b"
2084 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2085 (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
2086 (org-trim (org-table-get-field)))))
2087 ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
2088 ;; a new row before the rule.
2089 (should
2090 (equal
2091 "| a |\n| |\n|---|\n| b |"
2092 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2093 (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
2094 (buffer-string)))))
2095
2096 (provide 'test-org-table)
2097
2098 ;;; test-org-table.el ends here
Org-mode, an Emacs mode for organizing your life.