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 (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