testing/lisp/test-org-export.el

   1 ;;; test-org-export.el --- Tests for org-export.el
   2
   3 ;; Copyright (C) 2012  Nicolas Goaziou
   4
   5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
   6
   7 ;; Released under the GNU General Public License version 3
   8 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
   9
  10 ;;;; Comments
  11
  12
  13 \f
  14 ;;; Code:
  15
  16 (unless (featurep 'org-export)
  17   (signal 'missing-test-dependency "org-export"))
  18
  19 (defmacro org-test-with-backend (backend &rest body)
  20   "Execute body with an export back-end defined.
  21
  22 BACKEND is the name of the back-end.  BODY is the body to
  23 execute.  The defined back-end simply returns parsed data as Org
  24 syntax."
  25   (declare (debug (form body)) (indent 1))
  26   `(let ((org-export-registered-backends
  27           ',(list
  28              (list backend
  29                    :translate-alist
  30                    (let (transcode-table)
  31                      (dolist (type (append org-element-all-elements
  32                                            org-element-all-objects)
  33                                    transcode-table)
  34                        (push
  35                         (cons type
  36                               (lambda (obj contents info)
  37                                 (funcall
  38                                  (intern (format "org-element-%s-interpreter"
  39                                                  type))
  40                                  obj contents)))
  41                         transcode-table)))))))
  42      (progn ,@body)))
  43
  44 (defmacro org-test-with-parsed-data (data &rest body)
  45   "Execute body with parsed data available.
  46
  47 DATA is a string containing the data to be parsed.  BODY is the
  48 body to execute.  Parse tree is available under the `tree'
  49 variable, and communication channel under `info'.
  50
  51 This function calls `org-export-collect-tree-properties'.  As
  52 such, `:ignore-list' (for `org-element-map') and
  53 `:parse-tree' (for `org-export-get-genealogy') properties are
  54 already filled in `info'."
  55   (declare (debug (form body)) (indent 1))
  56   `(org-test-with-temp-text ,data
  57      (let* ((tree (org-element-parse-buffer))
  58             (info (org-export-collect-tree-properties
  59                    tree (org-export-get-environment))))
  60        ,@body)))
  61
  62
  63 \f
  64 ;;; Internal Tests
  65
  66 (ert-deftest test-org-export/bind-keyword ()
  67   "Test reading #+BIND: keywords."
  68   ;; Test with `org-export-all-BIND' set to t.
  69   (should
  70    (org-test-with-temp-text "#+BIND: variable value"
  71      (let ((org-export-allow-BIND t))
  72        (org-export--install-letbind-maybe)
  73        (eq variable 'value))))
  74   ;; Test with `org-export-all-BIND' set to nil.
  75   (should-not
  76    (org-test-with-temp-text "#+BIND: variable value"
  77      (let ((org-export-allow-BIND nil))
  78        (org-export--install-letbind-maybe)
  79        (boundp 'variable))))
  80   ;; Test with `org-export-all-BIND' set to 'confirm and
  81   ;; `org-export--allow-BIND-local' to t .
  82   (should
  83    (org-test-with-temp-text "#+BIND: variable value"
  84      (let ((org-export-allow-BIND 'confirm))
  85        (org-set-local 'org-export--allow-BIND-local t)
  86        (org-export--install-letbind-maybe)
  87        (eq variable 'value))))
  88   ;; Test with `org-export-all-BIND' set to 'confirm and
  89   ;; `org-export--allow-BIND-local' to nil.
  90   (should-not
  91    (org-test-with-temp-text "#+BIND: variable value"
  92      (let ((org-export-allow-BIND 'confirm))
  93        (org-set-local 'org-export--allow-BIND-local nil)
  94        (org-export--install-letbind-maybe)
  95        (boundp 'variable))))
  96   ;; BIND keywords are case-insensitive.
  97   (should
  98    (org-test-with-temp-text "#+bind: variable value"
  99      (let ((org-export-allow-BIND t))
 100        (org-export--install-letbind-maybe)
 101        (eq variable 'value)))))
 102
 103 (ert-deftest test-org-export/parse-option-keyword ()
 104   "Test reading all standard #+OPTIONS: items."
 105   (should
 106    (equal
 107     (org-export--parse-option-keyword
 108      "H:1 num:t \\n:t timestamp:t arch:t author:t creator:t d:t email:t
 109  *:t e:t ::t f:t pri:t -:t ^:t toc:t |:t tags:t tasks:t <:t todo:t inline:nil
 110  stat:t")
 111     '(:headline-levels
 112       1 :preserve-breaks t :section-numbers t :time-stamp-file t
 113       :with-archived-trees t :with-author t :with-creator t :with-drawers t
 114       :with-email t :with-emphasize t :with-entities t :with-fixed-width t
 115       :with-footnotes t :with-inlinetasks nil :with-priority t
 116       :with-special-strings t :with-statistics-cookies t :with-sub-superscript t
 117       :with-toc t :with-tables t :with-tags t :with-tasks t :with-timestamps t
 118       :with-todo-keywords t)))
 119   ;; Test some special values.
 120   (should
 121    (equal
 122     (org-export--parse-option-keyword
 123      "arch:headline creator:comment d:(\"TEST\")
 124  ^:{} toc:1 tags:not-in-toc tasks:todo num:2 <:active")
 125     '( :section-numbers
 126        2
 127        :with-archived-trees headline :with-creator comment
 128        :with-drawers ("TEST") :with-sub-superscript {} :with-toc 1
 129        :with-tags not-in-toc :with-tasks todo :with-timestamps active))))
 130
 131 (ert-deftest test-org-export/get-inbuffer-options ()
 132   "Test reading all standard export keywords."
 133   (should
 134    (equal
 135     (org-test-with-temp-text "#+AUTHOR: Me, Myself and I
 136 #+CREATOR: Idem
 137 #+DATE: Today
 138 #+DESCRIPTION: Testing
 139 #+DESCRIPTION: with two lines
 140 #+EMAIL: some@email.org
 141 #+EXCLUDE_TAGS: noexport invisible
 142 #+KEYWORDS: test
 143 #+LANGUAGE: en
 144 #+SELECT_TAGS: export
 145 #+TITLE: Some title
 146 #+TITLE: with spaces"
 147       (org-export--get-inbuffer-options))
 148     '(:author
 149       ("Me, Myself and I") :creator "Idem" :date ("Today")
 150       :description "Testing\nwith two lines" :email "some@email.org"
 151       :exclude-tags ("noexport" "invisible") :keywords "test" :language "en"
 152       :select-tags ("export") :title ("Some title with spaces")))))
 153
 154 (ert-deftest test-org-export/get-subtree-options ()
 155   "Test setting options from headline's properties."
 156   ;; EXPORT_TITLE.
 157   (org-test-with-temp-text "#+TITLE: Title
 158 * Headline
 159   :PROPERTIES:
 160   :EXPORT_TITLE: Subtree Title
 161   :END:
 162 Paragraph"
 163     (forward-line)
 164     (should (equal (plist-get (org-export-get-environment nil t) :title)
 165                    '("Subtree Title"))))
 166   :title
 167   '("subtree-title")
 168   ;; EXPORT_OPTIONS.
 169   (org-test-with-temp-text "#+OPTIONS: H:1
 170 * Headline
 171   :PROPERTIES:
 172   :EXPORT_OPTIONS: H:2
 173   :END:
 174 Paragraph"
 175     (forward-line)
 176     (should
 177      (= 2 (plist-get (org-export-get-environment nil t) :headline-levels))))
 178   ;; EXPORT_DATE.
 179   (org-test-with-temp-text "#+DATE: today
 180 * Headline
 181   :PROPERTIES:
 182   :EXPORT_DATE: 29-03-2012
 183   :END:
 184 Paragraph"
 185     (forward-line)
 186     (should (equal (plist-get (org-export-get-environment nil t) :date)
 187                    '("29-03-2012"))))
 188   ;; Properties with `split' behaviour are stored as a list of
 189   ;; strings.
 190   (should
 191    (equal '("a" "b")
 192           (org-test-with-temp-text "#+EXCLUDE_TAGS: noexport
 193 * Headline
 194   :PROPERTIES:
 195   :EXPORT_EXCLUDE_TAGS: a b
 196   :END:
 197 Paragraph"
 198             (progn
 199               (forward-line)
 200               (plist-get (org-export-get-environment nil t) :exclude-tags)))))
 201   ;; Handle :PROPERTY+: syntax.
 202   (should
 203    (equal '("a" "b")
 204           (org-test-with-temp-text "#+EXCLUDE_TAGS: noexport
 205 * Headline
 206   :PROPERTIES:
 207   :EXPORT_EXCLUDE_TAGS: a
 208   :EXPORT_EXCLUDE_TAGS+: b
 209   :END:
 210 Paragraph"
 211             (progn
 212               (forward-line)
 213               (plist-get (org-export-get-environment nil t) :exclude-tags)))))
 214   ;; Export properties are case-insensitive.
 215   (org-test-with-temp-text "* Headline
 216   :PROPERTIES:
 217   :EXPORT_Date: 29-03-2012
 218   :END:
 219 Paragraph"
 220     (should (equal (plist-get (org-export-get-environment nil t) :date)
 221                    '("29-03-2012")))))
 222
 223 (ert-deftest test-org-export/handle-options ()
 224   "Test if export options have an impact on output."
 225   ;; Test exclude tags.
 226   (org-test-with-temp-text "* Head1 :noexport:"
 227     (org-test-with-backend test
 228       (should
 229        (equal (org-export-as 'test nil nil nil '(:exclude-tags ("noexport")))
 230               ""))))
 231   ;; Test include tags.
 232   (org-test-with-temp-text "
 233 * Head1
 234 * Head2
 235 ** Sub-Head2.1 :export:
 236 *** Sub-Head2.1.1
 237 * Head2"
 238     (org-test-with-backend test
 239       (should
 240        (equal
 241         "* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n"
 242         (let ((org-tags-column 0))
 243           (org-export-as 'test nil nil nil '(:select-tags ("export"))))))))
 244   ;; Test mixing include tags and exclude tags.
 245   (org-test-with-temp-text "
 246 * Head1 :export:
 247 ** Sub-Head1 :noexport:
 248 ** Sub-Head2
 249 * Head2 :noexport:
 250 ** Sub-Head1 :export:"
 251     (org-test-with-backend test
 252       (should
 253        (string-match
 254         "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n"
 255         (org-export-as
 256          'test nil nil nil
 257          '(:select-tags ("export") :exclude-tags ("noexport")))))))
 258   ;; Ignore tasks.
 259   (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
 260     (org-test-with-temp-text "* TODO Head1"
 261       (org-test-with-backend test
 262         (should (equal (org-export-as 'test nil nil nil '(:with-tasks nil))
 263                        "")))))
 264   (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
 265     (org-test-with-temp-text "* TODO Head1"
 266       (org-test-with-backend test
 267         (should (equal (org-export-as 'test nil nil nil '(:with-tasks t))
 268                        "* TODO Head1\n")))))
 269   ;; Archived tree.
 270   (org-test-with-temp-text "* Head1 :archive:"
 271     (let ((org-archive-tag "archive"))
 272       (org-test-with-backend test
 273         (should
 274          (equal (org-export-as 'test nil nil nil '(:with-archived-trees nil))
 275                 "")))))
 276   (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2"
 277     (let ((org-archive-tag "archive"))
 278       (org-test-with-backend test
 279         (should
 280          (string-match
 281           "\\* Head1[ \t]+:archive:"
 282           (org-export-as 'test nil nil nil
 283                          '(:with-archived-trees headline)))))))
 284   (org-test-with-temp-text "* Head1 :archive:"
 285     (let ((org-archive-tag "archive"))
 286       (org-test-with-backend test
 287         (should
 288          (string-match
 289           "\\`\\* Head1[ \t]+:archive:\n\\'"
 290           (org-export-as 'test nil nil nil '(:with-archived-trees t)))))))
 291   ;; Drawers.
 292   (let ((org-drawers '("TEST")))
 293     (org-test-with-temp-text ":TEST:\ncontents\n:END:"
 294       (org-test-with-backend test
 295         (should (equal (org-export-as 'test nil nil nil '(:with-drawers nil))
 296                        ""))
 297         (should (equal (org-export-as 'test nil nil nil '(:with-drawers t))
 298                        ":TEST:\ncontents\n:END:\n")))))
 299   (let ((org-drawers '("FOO" "BAR")))
 300     (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
 301       (org-test-with-backend test
 302         (should
 303          (equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO")))
 304                 ":FOO:\nkeep\n:END:\n")))))
 305   ;; Timestamps.
 306   (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>"
 307     (org-test-with-backend test
 308       (should
 309        (equal (org-export-as 'test nil nil nil '(:with-timestamps t))
 310               "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n"))
 311       (should
 312        (equal (org-export-as 'test nil nil nil '(:with-timestamps nil)) ""))
 313       (should
 314        (equal (org-export-as 'test nil nil nil '(:with-timestamps active))
 315               "<2012-04-29 sun. 10:45>\n"))
 316       (should
 317        (equal (org-export-as 'test nil nil nil '(:with-timestamps inactive))
 318               "[2012-04-29 sun. 10:45]\n"))))
 319   ;; Clocks.
 320   (let ((org-clock-string "CLOCK:"))
 321     (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
 322       (org-test-with-backend test
 323         (should
 324          (equal (org-export-as 'test nil nil nil '(:with-clocks t))
 325                 "CLOCK: [2012-04-29 sun. 10:45]\n"))
 326         (should
 327          (equal (org-export-as 'test nil nil nil '(:with-clocks nil)) "")))))
 328   ;; Plannings.
 329   (let ((org-closed-string "CLOSED:"))
 330     (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
 331       (org-test-with-backend test
 332         (should
 333          (equal (org-export-as 'test nil nil nil '(:with-plannings t))
 334                 "CLOSED: [2012-04-29 sun. 10:45]\n"))
 335         (should
 336          (equal (org-export-as 'test nil nil nil '(:with-plannings nil))
 337                 "")))))
 338   ;; Inlinetasks.
 339   (when (featurep 'org-inlinetask)
 340     (should
 341      (equal
 342       (let ((org-inlinetask-min-level 15))
 343         (org-test-with-temp-text "*************** Task"
 344           (org-test-with-backend test
 345             (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
 346       ""))
 347     (should
 348      (equal
 349       (let ((org-inlinetask-min-level 15))
 350         (org-test-with-temp-text
 351             "*************** Task\nContents\n*************** END"
 352           (org-test-with-backend test
 353             (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
 354       "")))
 355   ;; Statistics cookies.
 356   (should
 357    (equal ""
 358           (org-test-with-temp-text "[0/0]"
 359             (org-test-with-backend test
 360               (org-export-as
 361                'test nil nil nil '(:with-statistics-cookies nil)))))))
 362
 363 (ert-deftest test-org-export/comment-tree ()
 364   "Test if export process ignores commented trees."
 365   (let ((org-comment-string "COMMENT"))
 366     (org-test-with-temp-text "* COMMENT Head1"
 367       (org-test-with-backend test
 368         (should (equal (org-export-as 'test) ""))))))
 369
 370 (ert-deftest test-org-export/export-scope ()
 371   "Test all export scopes."
 372   (org-test-with-temp-text "
 373 * Head1
 374 ** Head2
 375 text
 376 *** Head3"
 377     (org-test-with-backend test
 378       ;; Subtree.
 379       (forward-line 3)
 380       (should (equal (org-export-as 'test 'subtree) "text\n*** Head3\n"))
 381       ;; Visible.
 382       (goto-char (point-min))
 383       (forward-line)
 384       (org-cycle)
 385       (should (equal (org-export-as 'test nil 'visible) "* Head1\n"))
 386       ;; Region.
 387       (goto-char (point-min))
 388       (forward-line 3)
 389       (transient-mark-mode 1)
 390       (push-mark (point) t t)
 391       (goto-char (point-at-eol))
 392       (should (equal (org-export-as 'test) "text\n"))))
 393   ;; Subtree with a code block calling another block outside.
 394   (should
 395    (equal ": 3\n"
 396           (org-test-with-temp-text "
 397 * Head1
 398 #+BEGIN_SRC emacs-lisp :noweb yes :exports results
 399 <<test>>
 400 #+END_SRC
 401 * Head2
 402 #+NAME: test
 403 #+BEGIN_SRC emacs-lisp
 404 \(+ 1 2)
 405 #+END_SRC"
 406             (org-test-with-backend test
 407               (forward-line 1)
 408               (org-export-as 'test 'subtree)))))
 409   ;; Body only.
 410   (org-test-with-temp-text "Text"
 411     (org-test-with-backend test
 412       (plist-put
 413        (cdr (assq 'test org-export-registered-backends))
 414        :translate-alist
 415        (cons (cons 'template (lambda (body info) (format "BEGIN\n%sEND" body)))
 416              (org-export-backend-translate-table 'test)))
 417       (should (equal (org-export-as 'test nil nil 'body-only) "Text\n"))
 418       (should (equal (org-export-as 'test) "BEGIN\nText\nEND")))))
 419
 420 (ert-deftest test-org-export/expand-include ()
 421   "Test file inclusion in an Org buffer."
 422   ;; Error when file isn't specified.
 423   (should-error
 424    (org-test-with-temp-text "#+INCLUDE: dummy.org"
 425      (org-export-expand-include-keyword)))
 426   ;; Full insertion with recursive inclusion.
 427   (org-test-with-temp-text
 428       (format "#+INCLUDE: \"%s/examples/include.org\"" org-test-dir)
 429     (org-export-expand-include-keyword)
 430     (should (equal (buffer-string)
 431                    "Small Org file with an include keyword.
 432
 433 #+BEGIN_SRC emacs-lisp :exports results\n(+ 2 1)\n#+END_SRC
 434
 435 Success!
 436
 437 * Heading
 438 body\n")))
 439   ;; Localized insertion.
 440   (org-test-with-temp-text
 441       (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\""
 442               org-test-dir)
 443     (org-export-expand-include-keyword)
 444     (should (equal (buffer-string)
 445                    "Small Org file with an include keyword.\n")))
 446   ;; Insertion with constraints on headlines level.
 447   (org-test-with-temp-text
 448       (format
 449        "* Top heading\n#+INCLUDE: \"%s/examples/include.org\" :lines \"9-\""
 450        org-test-dir)
 451     (org-export-expand-include-keyword)
 452     (should (equal (buffer-string) "* Top heading\n** Heading\nbody\n")))
 453   ;; Inclusion within an example block.
 454   (org-test-with-temp-text
 455       (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\" example"
 456               org-test-dir)
 457     (org-export-expand-include-keyword)
 458     (should
 459      (equal
 460       (buffer-string)
 461       "#+BEGIN_EXAMPLE\nSmall Org file with an include keyword.\n#+END_EXAMPLE\n")))
 462   ;; Inclusion within a src-block.
 463   (org-test-with-temp-text
 464       (format
 465        "#+INCLUDE: \"%s/examples/include.org\" :lines \"4-5\" src emacs-lisp"
 466        org-test-dir)
 467     (org-export-expand-include-keyword)
 468     (should (equal (buffer-string)
 469                    "#+BEGIN_SRC emacs-lisp\n(+ 2 1)\n#+END_SRC\n"))))
 470
 471 (ert-deftest test-org-export/expand-macro ()
 472   "Test macro expansion in an Org buffer."
 473   ;; Standard macro expansion.
 474   (should
 475    (equal "#+MACRO: macro1 value\nvalue\n"
 476           (org-test-with-temp-text "#+MACRO: macro1 value\n{{{macro1}}}"
 477             (org-test-with-backend test (org-export-as 'test)))))
 478   ;; Expand specific macros.
 479   (should
 480    (equal "me 2012-03-29 me@here Title\n"
 481           (org-test-with-temp-text
 482               "
 483 #+TITLE: Title
 484 #+DATE: 2012-03-29
 485 #+AUTHOR: me
 486 #+EMAIL: me@here
 487 {{{author}}} {{{date}}} {{{email}}} {{{title}}}"
 488             (let ((output (org-test-with-backend test (org-export-as 'test))))
 489               (substring output (string-match ".*\n\\'" output))))))
 490   ;; Expand specific macros when property contained a regular macro
 491   ;; already.
 492   (should
 493    (equal "value\n"
 494           (org-test-with-temp-text "
 495 #+MACRO: macro1 value
 496 #+TITLE: {{{macro1}}}
 497 {{{title}}}"
 498             (let ((output (org-test-with-backend test (org-export-as 'test))))
 499               (substring output (string-match ".*\n\\'" output))))))
 500   ;; Expand macros with templates in included files.
 501   (should
 502    (equal "success\n"
 503           (org-test-with-temp-text
 504               (format "#+INCLUDE: \"%s/examples/macro-templates.org\"
 505 {{{included-macro}}}" org-test-dir)
 506             (let ((output (org-test-with-backend test (org-export-as 'test))))
 507               (substring output (string-match ".*\n\\'" output)))))))
 508
 509 (ert-deftest test-org-export/user-ignore-list ()
 510   "Test if `:ignore-list' accepts user input."
 511   (org-test-with-backend test
 512     (flet ((skip-note-head
 513             (data backend info)
 514             ;; Ignore headlines with the word "note" in their title.
 515             (org-element-map
 516              data 'headline
 517              (lambda (headline)
 518                (when (string-match "\\<note\\>"
 519                                    (org-element-property :raw-value headline))
 520                  (org-export-ignore-element headline info)))
 521              info)
 522             data))
 523       ;; Install function in parse tree filters.
 524       (let ((org-export-filter-parse-tree-functions '(skip-note-head)))
 525         (org-test-with-temp-text "* Head1\n* Head2 (note)\n"
 526           (should (equal (org-export-as 'test) "* Head1\n")))))))
 527
 528 (ert-deftest test-org-export/before-processing-hook ()
 529   "Test `org-export-before-processing-hook'."
 530   (should
 531    (equal
 532     "#+MACRO: mac val\nTest\n"
 533     (org-test-with-backend test
 534       (org-test-with-temp-text "#+MACRO: mac val\n{{{mac}}} Test"
 535         (let ((org-export-before-processing-hook
 536                '((lambda (backend)
 537                    (while (re-search-forward "{{{" nil t)
 538                      (let ((object (org-element-context)))
 539                        (when (eq (org-element-type object) 'macro)
 540                          (delete-region
 541                           (org-element-property :begin object)
 542                           (org-element-property :end object)))))))))
 543           (org-export-as 'test)))))))
 544
 545 (ert-deftest test-org-export/before-parsing-hook ()
 546   "Test `org-export-before-parsing-hook'."
 547   (should
 548    (equal "Body 1\nBody 2\n"
 549           (org-test-with-backend test
 550             (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody 2"
 551               (let ((org-export-before-parsing-hook
 552                      '((lambda (backend)
 553                          (org-map-entries
 554                           (lambda ()
 555                             (delete-region (point) (progn (forward-line) (point)))))))))
 556                 (org-export-as 'test)))))))
 557
 558
 559 \f
 560 ;;; Affiliated Keywords
 561
 562 (ert-deftest test-org-export/read-attribute ()
 563   "Test `org-export-read-attribute' specifications."
 564   ;; Standard test.
 565   (should
 566    (equal
 567     (org-export-read-attribute
 568      :attr_html
 569      (org-test-with-temp-text "#+ATTR_HTML: :a 1 :b 2\nParagraph"
 570        (org-element-at-point)))
 571     '(:a 1 :b 2)))
 572   ;; Return nil on empty attribute.
 573   (should-not
 574    (org-export-read-attribute
 575     :attr_html
 576     (org-test-with-temp-text "Paragraph" (org-element-at-point)))))
 577
 578 (ert-deftest test-org-export/get-caption ()
 579   "Test `org-export-get-caption' specifications."
 580   ;; Without optional argument, return long caption
 581   (should
 582    (equal
 583     '("l")
 584     (org-test-with-temp-text "#+CAPTION[s]: l\nPara"
 585       (org-export-get-caption (org-element-at-point)))))
 586   ;; With optional argument, return short caption.
 587   (should
 588    (equal
 589     '("s")
 590     (org-test-with-temp-text "#+CAPTION[s]: l\nPara"
 591       (org-export-get-caption (org-element-at-point) t))))
 592   ;; Multiple lines are separated by white spaces.
 593   (should
 594    (equal
 595     '("a" " " "b")
 596     (org-test-with-temp-text "#+CAPTION: a\n#+CAPTION: b\nPara"
 597       (org-export-get-caption (org-element-at-point))))))
 598
 599
 600 \f
 601 ;;; Back-end Definition
 602
 603 (ert-deftest test-org-export/define-backend ()
 604   "Test back-end definition and accessors."
 605   ;; Translate table.
 606   (should
 607    (equal '((headline . my-headline-test))
 608           (let (org-export-registered-backends)
 609             (org-export-define-backend test ((headline . my-headline-test)))
 610             (org-export-backend-translate-table 'test))))
 611   ;; Filters.
 612   (should
 613    (equal '((:filter-headline . my-filter))
 614           (let (org-export-registered-backends)
 615             (org-export-define-backend test
 616               ((headline . my-headline-test))
 617               :filters-alist ((:filter-headline . my-filter)))
 618             (org-export-backend-filters 'test))))
 619   ;; Options.
 620   (should
 621    (equal '((:prop value))
 622           (let (org-export-registered-backends)
 623             (org-export-define-backend test
 624               ((headline . my-headline-test))
 625               :options-alist ((:prop value)))
 626             (org-export-backend-options 'test))))
 627   ;; Menu.
 628   (should
 629    (equal '(?k "Test Export" test)
 630           (let (org-export-registered-backends)
 631             (org-export-define-backend test
 632               ((headline . my-headline-test))
 633               :menu-entry (?k "Test Export" test))
 634             (org-export-backend-menu 'test))))
 635   ;; Export Blocks.
 636   (should
 637    (equal '(("TEST" . org-element-export-block-parser))
 638           (let (org-export-registered-backends org-element-block-name-alist)
 639             (org-export-define-backend test
 640               ((headline . my-headline-test))
 641               :export-block ("test"))
 642             org-element-block-name-alist))))
 643
 644 (ert-deftest test-org-export/define-derived-backend ()
 645   "Test `org-export-define-derived-backend' specifications."
 646   ;; Error when parent back-end is not defined.
 647   (should-error
 648    (let (org-export-registered-backends)
 649      (org-export-define-derived-backend test parent)))
 650   ;; Append translation table to parent's.
 651   (should
 652    (equal '((:headline . test) (:headline . parent))
 653           (let (org-export-registered-backends)
 654             (org-export-define-backend parent ((:headline . parent)))
 655             (org-export-define-derived-backend test parent
 656               :translate-alist ((:headline . test)))
 657             (org-export-backend-translate-table 'test)))))
 658
 659 (ert-deftest test-org-export/derived-backend-p ()
 660   "Test `org-export-derived-backend-p' specifications."
 661   ;; Non-nil with direct match.
 662   (should
 663    (let (org-export-registered-backends)
 664      (org-export-define-backend test ((headline . test)))
 665      (org-export-derived-backend-p 'test 'test)))
 666   (should
 667    (let (org-export-registered-backends)
 668      (org-export-define-backend test ((headline . test)))
 669      (org-export-define-derived-backend test2 test)
 670      (org-export-derived-backend-p 'test2 'test2)))
 671   ;; Non-nil with a direct parent.
 672   (should
 673    (let (org-export-registered-backends)
 674      (org-export-define-backend test ((headline . test)))
 675      (org-export-define-derived-backend test2 test)
 676      (org-export-derived-backend-p 'test2 'test)))
 677   ;; Non-nil with an indirect parent.
 678   (should
 679    (let (org-export-registered-backends)
 680      (org-export-define-backend test ((headline . test)))
 681      (org-export-define-derived-backend test2 test)
 682      (org-export-define-derived-backend test3 test2)
 683      (org-export-derived-backend-p 'test3 'test)))
 684   ;; Nil otherwise.
 685   (should-not
 686    (let (org-export-registered-backends)
 687      (org-export-define-backend test ((headline . test)))
 688      (org-export-define-backend test2 ((headline . test2)))
 689      (org-export-derived-backend-p 'test2 'test)))
 690   (should-not
 691    (let (org-export-registered-backends)
 692      (org-export-define-backend test ((headline . test)))
 693      (org-export-define-backend test2 ((headline . test2)))
 694      (org-export-define-derived-backend test3 test2)
 695      (org-export-derived-backend-p 'test3 'test))))
 696
 697
 698 \f
 699 ;;; Export Snippets
 700
 701 (ert-deftest test-org-export/export-snippet ()
 702   "Test export snippets transcoding."
 703   (org-test-with-temp-text "@@test:A@@@@t:B@@"
 704     (org-test-with-backend test
 705       (plist-put
 706        (cdr (assq 'test org-export-registered-backends))
 707        :translate-alist
 708        (cons (cons 'export-snippet
 709                    (lambda (snippet contents info)
 710                      (when (eq (org-export-snippet-backend snippet) 'test)
 711                        (org-element-property :value snippet))))
 712              (org-export-backend-translate-table 'test)))
 713       (let ((org-export-snippet-translation-alist nil))
 714         (should (equal (org-export-as 'test) "A\n")))
 715       (let ((org-export-snippet-translation-alist '(("t" . "test"))))
 716         (should (equal (org-export-as 'test) "AB\n"))))))
 717
 718
 719 \f
 720 ;;; Footnotes
 721
 722 (ert-deftest test-org-export/footnotes ()
 723   "Test footnotes specifications."
 724   (let ((org-footnote-section nil)
 725         (org-export-with-footnotes t))
 726     ;; 1. Read every type of footnote.
 727     (should
 728      (equal
 729       '((1 . "A\n") (2 . "B") (3 . "C") (4 . "D"))
 730       (org-test-with-parsed-data
 731        "Text[fn:1] [1] [fn:label:C] [fn::D]\n\n[fn:1] A\n\n[1] B"
 732        (org-element-map
 733         tree 'footnote-reference
 734         (lambda (ref)
 735           (let ((def (org-export-get-footnote-definition ref info)))
 736             (cons (org-export-get-footnote-number ref info)
 737                   (if (eq (org-element-property :type ref) 'inline) (car def)
 738                     (car (org-element-contents
 739                           (car (org-element-contents def))))))))
 740         info))))
 741     ;; 2. Test nested footnotes order.
 742     (org-test-with-parsed-data
 743      "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C."
 744      (should
 745       (equal
 746        '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4))
 747        (org-element-map
 748         tree 'footnote-reference
 749         (lambda (ref)
 750           (when (org-export-footnote-first-reference-p ref info)
 751             (cons (org-export-get-footnote-number ref info)
 752                   (org-element-property :label ref))))
 753         info))))
 754     ;; 3. Test nested footnote in invisible definitions.
 755     (org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C."
 756       ;; Hide definitions.
 757       (narrow-to-region (point) (point-at-eol))
 758       (let* ((tree (org-element-parse-buffer))
 759              (info (org-combine-plists
 760                     `(:parse-tree ,tree)
 761                     (org-export-collect-tree-properties
 762                      tree (org-export-get-environment)))))
 763         ;; Both footnotes should be seen.
 764         (should
 765          (= (length (org-export-collect-footnote-definitions tree info)) 2))))
 766     ;; 4. Test footnotes definitions collection.
 767     (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3].
 768
 769 \[fn:2] B [fn:3] [fn::D].
 770
 771 \[fn:3] C."
 772                                (should (= (length (org-export-collect-footnote-definitions tree info))
 773                                           4)))
 774     ;; 5. Test export of footnotes defined outside parsing scope.
 775     (org-test-with-temp-text "[fn:1] Out of scope
 776 * Title
 777 Paragraph[fn:1]"
 778       (org-test-with-backend test
 779         (plist-put
 780          (cdr (assq 'test org-export-registered-backends))
 781          :translate-alist
 782          (cons (cons 'footnote-reference
 783                      (lambda (fn contents info)
 784                        (org-element-interpret-data
 785                         (org-export-get-footnote-definition fn info))))
 786                (org-export-backend-translate-table 'test)))
 787         (forward-line)
 788         (should (equal "ParagraphOut of scope\n"
 789                        (org-export-as 'test 'subtree)))))))
 790
 791
 792 \f
 793 ;;; Headlines and Inlinetasks
 794
 795 (ert-deftest test-org-export/get-relative-level ()
 796   "Test `org-export-get-relative-level' specifications."
 797   ;; Standard test.
 798   (should
 799    (equal '(1 2)
 800           (let ((org-odd-levels-only nil))
 801             (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 802               (org-element-map
 803                tree 'headline
 804                (lambda (h) (org-export-get-relative-level h info))
 805                info)))))
 806   ;; Missing levels
 807   (should
 808    (equal '(1 3)
 809           (let ((org-odd-levels-only nil))
 810             (org-test-with-parsed-data "** Headline 1\n**** Headline 2"
 811               (org-element-map
 812                tree 'headline
 813                (lambda (h) (org-export-get-relative-level h info))
 814                info))))))
 815
 816 (ert-deftest test-org-export/low-level-p ()
 817   "Test `org-export-low-level-p' specifications."
 818   (should
 819    (equal
 820     '(no yes)
 821     (let ((org-odd-levels-only nil))
 822       (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 823         (org-element-map
 824          tree 'headline
 825          (lambda (h) (if (org-export-low-level-p h info) 'yes 'no))
 826          (plist-put info :headline-levels 1)))))))
 827
 828 (ert-deftest test-org-export/get-headline-number ()
 829   "Test `org-export-get-headline-number' specifications."
 830   ;; Standard test.
 831   (should
 832    (equal
 833     '((1) (1 1))
 834     (let ((org-odd-levels-only nil))
 835       (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 836         (org-element-map
 837          tree 'headline
 838          (lambda (h) (org-export-get-headline-number h info))
 839          info)))))
 840   ;; Missing levels are replaced with 0.
 841   (should
 842    (equal
 843     '((1) (1 0 1))
 844     (let ((org-odd-levels-only nil))
 845       (org-test-with-parsed-data "* Headline 1\n*** Headline 2"
 846         (org-element-map
 847          tree 'headline
 848          (lambda (h) (org-export-get-headline-number h info))
 849          info))))))
 850
 851 (ert-deftest test-org-export/numbered-headline-p ()
 852   "Test `org-export-numbered-headline-p' specifications."
 853   ;; If `:section-numbers' is nil, never number headlines.
 854   (should-not
 855    (org-test-with-parsed-data "* Headline"
 856      (org-element-map
 857       tree 'headline
 858       (lambda (h) (org-export-numbered-headline-p h info))
 859       (plist-put info :section-numbers nil))))
 860   ;; If `:section-numbers' is a number, only number headlines with
 861   ;; a level greater that it.
 862   (should
 863    (equal
 864     '(yes no)
 865     (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 866       (org-element-map
 867        tree 'headline
 868        (lambda (h) (if (org-export-numbered-headline-p h info) 'yes 'no))
 869        (plist-put info :section-numbers 1)))))
 870   ;; Otherwise, headlines are always numbered.
 871   (should
 872    (org-test-with-parsed-data "* Headline"
 873      (org-element-map
 874       tree 'headline
 875       (lambda (h) (org-export-numbered-headline-p h info))
 876       (plist-put info :section-numbers t)))))
 877
 878 (ert-deftest test-org-export/number-to-roman ()
 879   "Test `org-export-number-to-roman' specifications."
 880   ;; If number is negative, return it as a string.
 881   (should (equal (org-export-number-to-roman -1) "-1"))
 882   ;; Otherwise, return it as a roman number.
 883   (should (equal (org-export-number-to-roman 1449) "MCDXLIX")))
 884
 885 (ert-deftest test-org-export/get-tags ()
 886   "Test `org-export-get-tags' specifications."
 887   (let ((org-export-exclude-tags '("noexport"))
 888         (org-export-select-tags '("export")))
 889     ;; Standard test: tags which are not a select tag, an exclude tag,
 890     ;; or specified as optional argument shouldn't be ignored.
 891     (should
 892      (org-test-with-parsed-data "* Headline :tag:"
 893        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 894                             info)))
 895     ;; Exclude tags are removed.
 896     (should-not
 897      (org-test-with-parsed-data "* Headline :noexport:"
 898        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 899                             info)))
 900     ;; Select tags are removed.
 901     (should-not
 902      (org-test-with-parsed-data "* Headline :export:"
 903        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 904                             info)))
 905     (should
 906      (equal
 907       '("tag")
 908       (org-test-with-parsed-data "* Headline :tag:export:"
 909         (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 910                              info))))
 911     ;; Tags provided in the optional argument are also ignored.
 912     (should-not
 913      (org-test-with-parsed-data "* Headline :ignore:"
 914        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 915                             info '("ignore"))))
 916     ;; Allow tag inheritance.
 917     (should
 918      (equal
 919       '(("tag") ("tag"))
 920       (org-test-with-parsed-data "* Headline :tag:\n** Sub-heading"
 921         (org-element-map
 922          tree 'headline
 923          (lambda (hl) (org-export-get-tags hl info nil t)) info))))
 924     ;; Tag inheritance checks FILETAGS keywords.
 925     (should
 926      (equal
 927       '(("a" "b" "tag"))
 928       (org-test-with-parsed-data "#+FILETAGS: :a:b:\n* Headline :tag:"
 929         (org-element-map
 930          tree 'headline
 931          (lambda (hl) (org-export-get-tags hl info nil t)) info))))))
 932
 933 (ert-deftest test-org-export/get-node-property ()
 934   "Test`org-export-get-node-property' specifications."
 935   ;; Standard test.
 936   (should
 937    (equal "value"
 938           (org-test-with-parsed-data "* Headline
 939   :PROPERTIES:
 940   :prop:     value
 941   :END:"
 942             (org-export-get-node-property
 943              :prop (org-element-map tree 'headline 'identity nil t)))))
 944   ;; Test inheritance.
 945   (should
 946    (equal "value"
 947           (org-test-with-parsed-data "* Parent
 948   :PROPERTIES:
 949   :prop:     value
 950   :END:
 951 ** Headline
 952    Paragraph"
 953             (org-export-get-node-property
 954              :prop (org-element-map tree 'paragraph 'identity nil t) t))))
 955   ;; Cannot return a value before the first headline.
 956   (should-not
 957    (org-test-with-parsed-data "Paragraph
 958 * Headline
 959   :PROPERTIES:
 960   :prop:     value
 961   :END:"
 962      (org-export-get-node-property
 963       :prop (org-element-map tree 'paragraph 'identity nil t)))))
 964
 965 (ert-deftest test-org-export/get-category ()
 966   "Test `org-export-get-category' specifications."
 967   ;; Standard test.
 968   (should
 969    (equal "value"
 970           (org-test-with-parsed-data "* Headline
 971   :PROPERTIES:
 972   :CATEGORY:     value
 973   :END:"
 974             (org-export-get-category
 975              (org-element-map tree 'headline 'identity nil t) info))))
 976   ;; Test inheritance from a parent headline.
 977   (should
 978    (equal '("value" "value")
 979           (org-test-with-parsed-data "* Headline1
 980   :PROPERTIES:
 981   :CATEGORY:     value
 982   :END:
 983 ** Headline2"
 984             (org-element-map
 985              tree 'headline
 986              (lambda (hl) (org-export-get-category hl info)) info))))
 987   ;; Test inheritance from #+CATEGORY keyword
 988   (should
 989    (equal "value"
 990           (org-test-with-parsed-data "#+CATEGORY: value
 991 * Headline"
 992             (org-export-get-category
 993              (org-element-map tree 'headline 'identity nil t) info))))
 994   ;; Test inheritance from file name.
 995   (should
 996    (equal "test"
 997           (org-test-with-parsed-data "* Headline"
 998             (let ((info (plist-put info :input-file "~/test.org")))
 999               (org-export-get-category
1000                (org-element-map tree 'headline 'identity nil t) info)))))
1001   ;; Fall-back value.
1002   (should
1003    (equal "???"
1004           (org-test-with-parsed-data "* Headline"
1005             (org-export-get-category
1006              (org-element-map tree 'headline 'identity nil t) info)))))
1007
1008 (ert-deftest test-org-export/first-sibling-p ()
1009   "Test `org-export-first-sibling-p' specifications."
1010   ;; Standard test.
1011   (should
1012    (equal
1013     '(yes yes no)
1014     (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3"
1015       (org-element-map
1016        tree 'headline
1017        (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no))
1018        info))))
1019   ;; Ignore headlines not exported.
1020   (should
1021    (equal
1022     '(yes)
1023     (let ((org-export-exclude-tags '("ignore")))
1024       (org-test-with-parsed-data "* Headline :ignore:\n* Headline 2"
1025         (org-element-map
1026          tree 'headline
1027          (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no))
1028          info))))))
1029
1030 (ert-deftest test-org-export/last-sibling-p ()
1031   "Test `org-export-last-sibling-p' specifications."
1032   ;; Standard test.
1033   (should
1034    (equal
1035     '(yes no yes)
1036     (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3"
1037       (org-element-map
1038        tree 'headline
1039        (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no))
1040        info))))
1041   ;; Ignore headlines not exported.
1042   (should
1043    (equal
1044     '(yes)
1045     (let ((org-export-exclude-tags '("ignore")))
1046       (org-test-with-parsed-data "* Headline\n* Headline 2 :ignore:"
1047         (org-element-map
1048          tree 'headline
1049          (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no))
1050          info))))))
1051
1052
1053 \f
1054 ;;; Links
1055
1056 (ert-deftest test-org-export/get-coderef-format ()
1057   "Test `org-export-get-coderef-format' specifications."
1058   ;; A link without description returns "%s"
1059   (should (equal (org-export-get-coderef-format "(ref:line)" nil)
1060                  "%s"))
1061   ;; Return "%s" when path is matched within description.
1062   (should (equal (org-export-get-coderef-format "path" "desc (path)")
1063                  "desc %s"))
1064   ;; Otherwise return description.
1065   (should (equal (org-export-get-coderef-format "path" "desc")
1066                  "desc")))
1067
1068 (ert-deftest test-org-export/inline-image-p ()
1069   "Test `org-export-inline-image-p' specifications."
1070   (should
1071    (org-export-inline-image-p
1072     (org-test-with-temp-text "[[#id]]"
1073       (org-element-map
1074        (org-element-parse-buffer) 'link 'identity nil t))
1075     '(("custom-id" . "id")))))
1076
1077 (ert-deftest test-org-export/fuzzy-link ()
1078   "Test fuzzy links specifications."
1079   ;; 1. Links to invisible (keyword) targets should be ignored.
1080   (org-test-with-parsed-data
1081       "Paragraph.\n#+TARGET: Test\n[[Test]]"
1082     (should-not
1083      (org-element-map
1084       tree 'link
1085       (lambda (link)
1086         (org-export-get-ordinal
1087          (org-export-resolve-fuzzy-link link info) info)) info)))
1088   ;; 2. Link to an headline should return headline's number.
1089   (org-test-with-parsed-data
1090       "Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
1091     (should
1092      ;; Note: Headline's number is in fact a list of numbers.
1093      (equal '(2)
1094             (org-element-map
1095              tree 'link
1096              (lambda (link)
1097                (org-export-get-ordinal
1098                 (org-export-resolve-fuzzy-link link info) info)) info t))))
1099   ;; 3. Link to a target in an item should return item's number.
1100   (org-test-with-parsed-data
1101       "- Item1\n  - Item11\n  - <<test>>Item12\n- Item2\n\n\n[[test]]"
1102     (should
1103      ;; Note: Item's number is in fact a list of numbers.
1104      (equal '(1 2)
1105             (org-element-map
1106              tree 'link
1107              (lambda (link)
1108                (org-export-get-ordinal
1109                 (org-export-resolve-fuzzy-link link info) info)) info t))))
1110   ;; 4. Link to a target in a footnote should return footnote's
1111   ;;    number.
1112   (org-test-with-parsed-data "
1113 Paragraph[1][2][fn:lbl3:C<<target>>][[test]][[target]]\n[1] A\n\n[2] <<test>>B"
1114     (should
1115      (equal '(2 3)
1116             (org-element-map
1117              tree 'link
1118              (lambda (link)
1119                (org-export-get-ordinal
1120                 (org-export-resolve-fuzzy-link link info) info)) info))))
1121   ;; 5. Link to a named element should return sequence number of that
1122   ;;    element.
1123   (org-test-with-parsed-data
1124       "#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
1125     (should
1126      (= 2
1127         (org-element-map
1128          tree 'link
1129          (lambda (link)
1130            (org-export-get-ordinal
1131             (org-export-resolve-fuzzy-link link info) info)) info t))))
1132   ;; 6. Link to a target not within an item, a table, a footnote
1133   ;;    reference or definition should return section number.
1134   (org-test-with-parsed-data
1135       "* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
1136     (should
1137      (equal '(2)
1138             (org-element-map
1139              tree 'link
1140              (lambda (link)
1141                (org-export-get-ordinal
1142                 (org-export-resolve-fuzzy-link link info) info)) info t)))))
1143
1144 (ert-deftest test-org-export/resolve-coderef ()
1145   "Test `org-export-resolve-coderef' specifications."
1146   (let ((org-coderef-label-format "(ref:%s)"))
1147     ;; 1. A link to a "-n -k -r" block returns line number.
1148     (org-test-with-parsed-data
1149         "#+BEGIN_EXAMPLE -n -k -r\nText (ref:coderef)\n#+END_EXAMPLE"
1150       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1151     (org-test-with-parsed-data
1152         "#+BEGIN_SRC emacs-lisp -n -k -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
1153       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1154     ;; 2. A link to a "-n -r" block returns line number.
1155     (org-test-with-parsed-data
1156         "#+BEGIN_EXAMPLE -n -r\nText (ref:coderef)\n#+END_EXAMPLE"
1157       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1158     (org-test-with-parsed-data
1159         "#+BEGIN_SRC emacs-lisp -n -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
1160       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1161     ;; 3. A link to a "-n" block returns coderef.
1162     (org-test-with-parsed-data
1163         "#+BEGIN_SRC emacs-lisp -n\n(+ 1 1) (ref:coderef)\n#+END_SRC"
1164       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
1165     (org-test-with-parsed-data
1166         "#+BEGIN_EXAMPLE -n\nText (ref:coderef)\n#+END_EXAMPLE"
1167       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
1168     ;; 4. A link to a "-r" block returns line number.
1169     (org-test-with-parsed-data
1170         "#+BEGIN_SRC emacs-lisp -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
1171       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1172     (org-test-with-parsed-data
1173         "#+BEGIN_EXAMPLE -r\nText (ref:coderef)\n#+END_EXAMPLE"
1174       (should (= (org-export-resolve-coderef "coderef" info) 1)))
1175     ;; 5. A link to a block without a switch returns coderef.
1176     (org-test-with-parsed-data
1177         "#+BEGIN_SRC emacs-lisp\n(+ 1 1) (ref:coderef)\n#+END_SRC"
1178       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
1179     (org-test-with-parsed-data
1180         "#+BEGIN_EXAMPLE\nText (ref:coderef)\n#+END_EXAMPLE"
1181       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
1182     ;; 6. Correctly handle continued line numbers.  A "+n" switch
1183     ;;    should resume numbering from previous block with numbered
1184     ;;    lines, ignoring blocks not numbering lines in the process.
1185     ;;    A "-n" switch resets count.
1186     (org-test-with-parsed-data "
1187 #+BEGIN_EXAMPLE -n
1188 Text.
1189 #+END_EXAMPLE
1190
1191 #+BEGIN_SRC emacs-lisp
1192 \(- 1 1)
1193 #+END_SRC
1194
1195 #+BEGIN_SRC emacs-lisp +n -r
1196 \(+ 1 1) (ref:addition)
1197 #+END_SRC
1198
1199 #+BEGIN_EXAMPLE -n -r
1200 Another text. (ref:text)
1201 #+END_EXAMPLE"
1202       (should (= (org-export-resolve-coderef "addition" info) 2))
1203       (should (= (org-export-resolve-coderef "text" info) 1)))
1204     ;; 7. Recognize coderef with user-specified syntax.
1205     (org-test-with-parsed-data
1206         "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\nText. [ref:text]\n#+END_EXAMPLE"
1207       (should (equal (org-export-resolve-coderef "text" info) "text")))))
1208
1209 (ert-deftest test-org-export/resolve-fuzzy-link ()
1210   "Test `org-export-resolve-fuzzy-link' specifications."
1211   ;; 1. Match target objects.
1212   (org-test-with-parsed-data "<<target>> [[target]]"
1213     (should
1214      (org-export-resolve-fuzzy-link
1215       (org-element-map tree 'link 'identity info t) info)))
1216   ;; 2. Match target elements.
1217   (org-test-with-parsed-data "#+TARGET: target\n[[target]]"
1218     (should
1219      (org-export-resolve-fuzzy-link
1220       (org-element-map tree 'link 'identity info t) info)))
1221   ;; 3. Match named elements.
1222   (org-test-with-parsed-data "#+NAME: target\nParagraph\n\n[[target]]"
1223     (should
1224      (org-export-resolve-fuzzy-link
1225       (org-element-map tree 'link 'identity info t) info)))
1226   ;; 4. Match exact headline's name.
1227   (org-test-with-parsed-data "* My headline\n[[My headline]]"
1228     (should
1229      (org-export-resolve-fuzzy-link
1230       (org-element-map tree 'link 'identity info t) info)))
1231   ;; 5. Targets objects have priority over named elements and headline
1232   ;;    titles.
1233   (org-test-with-parsed-data
1234       "* target\n#+NAME: target\n<<target>>\n\n[[target]]"
1235     (should
1236      (eq 'target
1237          (org-element-type
1238           (org-export-resolve-fuzzy-link
1239            (org-element-map tree 'link 'identity info t) info)))))
1240   ;; 6. Named elements have priority over headline titles.
1241   (org-test-with-parsed-data
1242       "* target\n#+NAME: target\nParagraph\n\n[[target]]"
1243     (should
1244      (eq 'paragraph
1245          (org-element-type
1246           (org-export-resolve-fuzzy-link
1247            (org-element-map tree 'link 'identity info t) info)))))
1248   ;; 7. If link's path starts with a "*", only match headline titles,
1249   ;;    though.
1250   (org-test-with-parsed-data
1251       "* target\n#+NAME: target\n<<target>>\n\n[[*target]]"
1252     (should
1253      (eq 'headline
1254          (org-element-type
1255           (org-export-resolve-fuzzy-link
1256            (org-element-map tree 'link 'identity info t) info)))))
1257   ;; 8. Return nil if no match.
1258   (org-test-with-parsed-data "[[target]]"
1259     (should-not
1260      (org-export-resolve-fuzzy-link
1261       (org-element-map tree 'link 'identity info t) info))))
1262
1263 (ert-deftest test-org-export/resolve-id-link ()
1264   "Test `org-export-resolve-id-link' specifications."
1265   ;; 1. Regular test for custom-id link.
1266   (org-test-with-parsed-data "* Headline1
1267 :PROPERTIES:
1268 :CUSTOM-ID: test
1269 :END:
1270 * Headline 2
1271 \[[#test]]"
1272     (should
1273      (org-export-resolve-id-link
1274       (org-element-map tree 'link 'identity info t) info)))
1275   ;; 2. Failing test for custom-id link.
1276   (org-test-with-parsed-data "* Headline1
1277 :PROPERTIES:
1278 :CUSTOM-ID: test
1279 :END:
1280 * Headline 2
1281 \[[#no-match]]"
1282     (should-not
1283      (org-export-resolve-id-link
1284       (org-element-map tree 'link 'identity info t) info)))
1285   ;; 3. Test for internal id target.
1286   (org-test-with-parsed-data "* Headline1
1287 :PROPERTIES:
1288 :ID: aaaa
1289 :END:
1290 * Headline 2
1291 \[[id:aaaa]]"
1292     (should
1293      (org-export-resolve-id-link
1294       (org-element-map tree 'link 'identity info t) info)))
1295   ;; 4. Test for external id target.
1296   (org-test-with-parsed-data "[[id:aaaa]]"
1297     (should
1298      (org-export-resolve-id-link
1299       (org-element-map tree 'link 'identity info t)
1300       (org-combine-plists info '(:id-alist (("aaaa" . "external-file"))))))))
1301
1302 (ert-deftest test-org-export/resolve-radio-link ()
1303   "Test `org-export-resolve-radio-link' specifications."
1304   ;; Standard test.
1305   (org-test-with-temp-text "<<<radio>>> radio"
1306     (org-update-radio-target-regexp)
1307     (should
1308      (let* ((tree (org-element-parse-buffer))
1309             (info `(:parse-tree ,tree)))
1310        (org-export-resolve-radio-link
1311         (org-element-map tree 'link 'identity info t)
1312         info))))
1313   ;; Radio target with objects.
1314   (org-test-with-temp-text "<<<radio \\alpha>>> radio \\alpha"
1315     (org-update-radio-target-regexp)
1316     (should
1317      (let* ((tree (org-element-parse-buffer))
1318             (info `(:parse-tree ,tree)))
1319        (org-export-resolve-radio-link
1320         (org-element-map tree 'link 'identity info t)
1321         info)))))
1322
1323
1324 \f
1325 ;;; Src-block and example-block
1326
1327 (ert-deftest test-org-export/unravel-code ()
1328   "Test `org-export-unravel-code' function."
1329   (let ((org-coderef-label-format "(ref:%s)"))
1330     ;; 1. Code without reference.
1331     (org-test-with-temp-text "#+BEGIN_EXAMPLE\n(+ 1 1)\n#+END_EXAMPLE"
1332       (should (equal (org-export-unravel-code (org-element-at-point))
1333                      '("(+ 1 1)\n"))))
1334     ;; 2. Code with reference.
1335     (org-test-with-temp-text
1336         "#+BEGIN_EXAMPLE\n(+ 1 1) (ref:test)\n#+END_EXAMPLE"
1337       (should (equal (org-export-unravel-code (org-element-at-point))
1338                      '("(+ 1 1)\n" (1 . "test")))))
1339     ;; 3. Code with user-defined reference.
1340     (org-test-with-temp-text
1341         "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\n(+ 1 1) [ref:test]\n#+END_EXAMPLE"
1342       (should (equal (org-export-unravel-code (org-element-at-point))
1343                      '("(+ 1 1)\n" (1 . "test")))))
1344     ;; 4. Code references keys are relative to the current block.
1345     (org-test-with-temp-text "
1346 #+BEGIN_EXAMPLE -n
1347 \(+ 1 1)
1348 #+END_EXAMPLE
1349 #+BEGIN_EXAMPLE +n
1350 \(+ 2 2)
1351 \(+ 3 3) (ref:one)
1352 #+END_EXAMPLE"
1353       (goto-line 5)
1354       (should (equal (org-export-unravel-code (org-element-at-point))
1355                      '("(+ 2 2)\n(+ 3 3)\n" (2 . "one")))))))
1356
1357
1358 \f
1359 ;;; Smart Quotes
1360
1361 (ert-deftest test-org-export/activate-smart-quotes ()
1362   "Test `org-export-activate-smart-quotes' specifications."
1363   ;; Opening double quotes: standard test.
1364   (should
1365    (equal
1366     '("some &ldquo;paragraph")
1367     (let ((org-export-default-language "en"))
1368       (org-test-with-parsed-data "some \"paragraph"
1369         (org-element-map
1370          tree 'plain-text
1371          (lambda (s) (org-export-activate-smart-quotes s :html info))
1372          info)))))
1373   ;; Opening quotes: at the beginning of a paragraph.
1374   (should
1375    (equal
1376     '("&ldquo;begin")
1377     (let ((org-export-default-language "en"))
1378       (org-test-with-parsed-data "\"begin"
1379         (org-element-map
1380          tree 'plain-text
1381          (lambda (s) (org-export-activate-smart-quotes s :html info))
1382          info)))))
1383   ;; Opening quotes: after an object.
1384   (should
1385    (equal
1386     '("&ldquo;begin")
1387     (let ((org-export-default-language "en"))
1388       (org-test-with-parsed-data "=verb= \"begin"
1389         (org-element-map
1390          tree 'plain-text
1391          (lambda (s) (org-export-activate-smart-quotes s :html info))
1392          info)))))
1393   ;; Closing quotes: standard test.
1394   (should
1395    (equal
1396     '("some&rdquo; paragraph")
1397     (let ((org-export-default-language "en"))
1398       (org-test-with-parsed-data "some\" paragraph"
1399         (org-element-map
1400          tree 'plain-text
1401          (lambda (s) (org-export-activate-smart-quotes s :html info))
1402          info)))))
1403   ;; Closing quotes: at the end of a paragraph.
1404   (should
1405    (equal
1406     '("end&rdquo;")
1407     (let ((org-export-default-language "en"))
1408       (org-test-with-parsed-data "end\""
1409         (org-element-map
1410          tree 'plain-text
1411          (lambda (s) (org-export-activate-smart-quotes s :html info))
1412          info)))))
1413   ;; Apostrophe: standard test.
1414   (should
1415    (equal
1416     '("It shouldn&rsquo;t fail")
1417     (let ((org-export-default-language "en"))
1418       (org-test-with-parsed-data "It shouldn't fail"
1419         (org-element-map
1420          tree 'plain-text
1421          (lambda (s) (org-export-activate-smart-quotes s :html info))
1422          info)))))
1423   ;; Apostrophe: before an object.
1424   (should
1425    (equal
1426     '("a&rsquo;")
1427     (let ((org-export-default-language "en"))
1428       (org-test-with-parsed-data "a'=b="
1429         (org-element-map
1430          tree 'plain-text
1431          (lambda (s) (org-export-activate-smart-quotes s :html info))
1432          info)))))
1433   ;; Apostrophe: after an object.
1434   (should
1435    (equal
1436     '("&rsquo;s")
1437     (let ((org-export-default-language "en"))
1438       (org-test-with-parsed-data "=code='s"
1439         (org-element-map
1440          tree 'plain-text
1441          (lambda (s) (org-export-activate-smart-quotes s :html info))
1442          info)))))
1443   ;; Special case: isolated quotes.
1444   (should
1445    (equal '("&ldquo;" "&rdquo;")
1446           (let ((org-export-default-language "en"))
1447             (org-test-with-parsed-data "\"$x$\""
1448               (org-element-map
1449                tree 'plain-text
1450                (lambda (s) (org-export-activate-smart-quotes s :html info))
1451                info)))))
1452   ;; Smart quotes in secondary strings.
1453   (should
1454    (equal '("&ldquo;" "&rdquo;")
1455           (let ((org-export-default-language "en"))
1456             (org-test-with-parsed-data "* \"$x$\""
1457               (org-element-map
1458                tree 'plain-text
1459                (lambda (s) (org-export-activate-smart-quotes s :html info))
1460                info)))))
1461   ;; Smart quotes in document keywords.
1462   (should
1463    (equal '("&ldquo;" "&rdquo;")
1464           (let ((org-export-default-language "en"))
1465             (org-test-with-parsed-data "#+TITLE: \"$x$\""
1466               (org-element-map
1467                (plist-get info :title) 'plain-text
1468                (lambda (s) (org-export-activate-smart-quotes s :html info))
1469                info)))))
1470   ;; Smart quotes in parsed affiliated keywords.
1471   (should
1472    (equal '("&ldquo;" "&rdquo;" "Paragraph")
1473           (let ((org-export-default-language "en"))
1474             (org-test-with-parsed-data "#+CAPTION: \"$x$\"\nParagraph"
1475               (org-element-map
1476                tree 'plain-text
1477                (lambda (s) (org-export-activate-smart-quotes s :html info))
1478                info nil nil t))))))
1479
1480
1481 \f
1482 ;;; Tables
1483
1484 (ert-deftest test-org-export/special-column ()
1485   "Test if the table's special column is properly recognized."
1486   ;; 1. First column is special if it contains only a special marking
1487   ;;    characters or empty cells.
1488   (org-test-with-temp-text "
1489 | ! | 1 |
1490 |   | 2 |"
1491     (should
1492      (org-export-table-has-special-column-p
1493       (org-element-map
1494        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1495   ;; 2. If the column contains anything else, it isn't special.
1496   (org-test-with-temp-text "
1497 | ! | 1 |
1498 | b | 2 |"
1499     (should-not
1500      (org-export-table-has-special-column-p
1501       (org-element-map
1502        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1503   ;; 3. Special marking characters are "#", "^", "*", "_", "/", "$"
1504   ;;    and "!".
1505   (org-test-with-temp-text "
1506 | # | 1 |
1507 | ^ | 2 |
1508 | * | 3 |
1509 | _ | 4 |
1510 | / | 5 |
1511 | $ | 6 |
1512 | ! | 7 |"
1513     (should
1514      (org-export-table-has-special-column-p
1515       (org-element-map
1516        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1517   ;; 4. A first column with only empty cells isn't considered as
1518   ;;    special.
1519   (org-test-with-temp-text "
1520 |   | 1 |
1521 |   | 2 |"
1522     (should-not
1523      (org-export-table-has-special-column-p
1524       (org-element-map
1525        (org-element-parse-buffer) 'table 'identity nil 'first-match)))))
1526
1527 (ert-deftest test-org-export/table-row-is-special-p ()
1528   "Test `org-export-table-row-is-special-p' specifications."
1529   ;; 1. A row is special if it has a special marking character in the
1530   ;;    special column.
1531   (org-test-with-parsed-data "| ! | 1 |"
1532     (should
1533      (org-export-table-row-is-special-p
1534       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1535   ;; 2. A row is special when its first field is "/"
1536   (org-test-with-parsed-data "
1537 | / | 1 |
1538 | a | b |"
1539     (should
1540      (org-export-table-row-is-special-p
1541       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1542   ;; 3. A row only containing alignment cookies is also considered as
1543   ;;    special.
1544   (org-test-with-parsed-data "| <5> |   | <l> | <l22> |"
1545     (should
1546      (org-export-table-row-is-special-p
1547       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1548   ;; 4. Everything else isn't considered as special.
1549   (org-test-with-parsed-data "| \alpha |   | c |"
1550     (should-not
1551      (org-export-table-row-is-special-p
1552       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1553   ;; 5. Table's rules are never considered as special rows.
1554   (org-test-with-parsed-data "|---+---|"
1555     (should-not
1556      (org-export-table-row-is-special-p
1557       (org-element-map tree 'table-row 'identity nil 'first-match) info))))
1558
1559 (ert-deftest test-org-export/has-header-p ()
1560   "Test `org-export-table-has-header-p' specifications."
1561   ;; 1. With an header.
1562   (org-test-with-parsed-data "
1563 | a | b |
1564 |---+---|
1565 | c | d |"
1566     (should
1567      (org-export-table-has-header-p
1568       (org-element-map tree 'table 'identity info 'first-match)
1569       info)))
1570   ;; 2. Without an header.
1571   (org-test-with-parsed-data "
1572 | a | b |
1573 | c | d |"
1574     (should-not
1575      (org-export-table-has-header-p
1576       (org-element-map tree 'table 'identity info 'first-match)
1577       info)))
1578   ;; 3. Don't get fooled with starting and ending rules.
1579   (org-test-with-parsed-data "
1580 |---+---|
1581 | a | b |
1582 | c | d |
1583 |---+---|"
1584     (should-not
1585      (org-export-table-has-header-p
1586       (org-element-map tree 'table 'identity info 'first-match)
1587       info))))
1588
1589 (ert-deftest test-org-export/table-row-group ()
1590   "Test `org-export-table-row-group' specifications."
1591   ;; 1. A rule creates a new group.
1592   (org-test-with-parsed-data "
1593 | a | b |
1594 |---+---|
1595 | 1 | 2 |"
1596     (should
1597      (equal
1598       '(1 nil 2)
1599       (mapcar (lambda (row) (org-export-table-row-group row info))
1600               (org-element-map tree 'table-row 'identity)))))
1601   ;; 2. Special rows are ignored in count.
1602   (org-test-with-parsed-data "
1603 | / | < | > |
1604 |---|---+---|
1605 |   | 1 | 2 |"
1606     (should
1607      (equal
1608       '(nil nil 1)
1609       (mapcar (lambda (row) (org-export-table-row-group row info))
1610               (org-element-map tree 'table-row 'identity)))))
1611   ;; 3. Double rules also are ignored in count.
1612   (org-test-with-parsed-data "
1613 | a | b |
1614 |---+---|
1615 |---+---|
1616 | 1 | 2 |"
1617     (should
1618      (equal
1619       '(1 nil nil 2)
1620       (mapcar (lambda (row) (org-export-table-row-group row info))
1621               (org-element-map tree 'table-row 'identity))))))
1622
1623 (ert-deftest test-org-export/table-cell-width ()
1624   "Test `org-export-table-cell-width' specifications."
1625   ;; 1. Width is primarily determined by width cookies.  If no cookie
1626   ;;    is found, cell's width is nil.
1627   (org-test-with-parsed-data "
1628 | / | <l> | <6> | <l7> |
1629 |   |  a  |  b  |  c   |"
1630     (should
1631      (equal
1632       '(nil 6 7)
1633       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1634               (org-element-map tree 'table-cell 'identity info)))))
1635   ;; 2. The last width cookie has precedence.
1636   (org-test-with-parsed-data "
1637 | <6> |
1638 | <7> |
1639 |  a  |"
1640     (should
1641      (equal
1642       '(7)
1643       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1644               (org-element-map tree 'table-cell 'identity info)))))
1645   ;; 3. Valid width cookies must have a specific row.
1646   (org-test-with-parsed-data "| <6> | cell |"
1647     (should
1648      (equal
1649       '(nil nil)
1650       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1651               (org-element-map tree 'table-cell 'identity))))))
1652
1653 (ert-deftest test-org-export/table-cell-alignment ()
1654   "Test `org-export-table-cell-alignment' specifications."
1655   (let ((org-table-number-fraction 0.5)
1656         (org-table-number-regexp "^[0-9]+$"))
1657     ;; 1. Alignment is primarily determined by alignment cookies.
1658     (org-test-with-temp-text "| <l> | <c> | <r> |"
1659       (let* ((tree (org-element-parse-buffer))
1660              (info `(:parse-tree ,tree)))
1661         (should
1662          (equal
1663           '(left center right)
1664           (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
1665                   (org-element-map tree 'table-cell 'identity))))))
1666     ;; 2. The last alignment cookie has precedence.
1667     (org-test-with-parsed-data "
1668 | <l8> |
1669 | cell |
1670 | <r9> |"
1671       (should
1672        (equal
1673         '(right right right)
1674         (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
1675                 (org-element-map tree 'table-cell 'identity)))))
1676     ;; 3. If there's no cookie, cell's contents determine alignment.
1677     ;;    A column mostly made of cells containing numbers will align
1678     ;;    its cells to the right.
1679     (org-test-with-parsed-data "
1680 | 123       |
1681 | some text |
1682 | 12345     |"
1683       (should
1684        (equal
1685         '(right right right)
1686         (mapcar (lambda (cell)
1687                   (org-export-table-cell-alignment cell info))
1688                 (org-element-map tree 'table-cell 'identity)))))
1689     ;; 4. Otherwise, they will be aligned to the left.
1690     (org-test-with-parsed-data "
1691 | text      |
1692 | some text |
1693 | \alpha    |"
1694       (should
1695        (equal
1696         '(left left left)
1697         (mapcar (lambda (cell)
1698                   (org-export-table-cell-alignment cell info))
1699                 (org-element-map tree 'table-cell 'identity)))))))
1700
1701 (ert-deftest test-org-export/table-cell-borders ()
1702   "Test `org-export-table-cell-borders' specifications."
1703   ;; 1. Recognize various column groups indicators.
1704   (org-test-with-parsed-data "| / | < | > | <> |"
1705     (should
1706      (equal
1707       '((right bottom top) (left bottom top) (right bottom top)
1708         (right left bottom top))
1709       (mapcar (lambda (cell)
1710                 (org-export-table-cell-borders cell info))
1711               (org-element-map tree 'table-cell 'identity)))))
1712   ;; 2. Accept shortcuts to define column groups.
1713   (org-test-with-parsed-data "| / | < | < |"
1714     (should
1715      (equal
1716       '((right bottom top) (right left bottom top) (left bottom top))
1717       (mapcar (lambda (cell)
1718                 (org-export-table-cell-borders cell info))
1719               (org-element-map tree 'table-cell 'identity)))))
1720   ;; 3. A valid column groups row must start with a "/".
1721   (org-test-with-parsed-data "
1722 |   | < |
1723 | a | b |"
1724     (should
1725      (equal '((top) (top) (bottom) (bottom))
1726             (mapcar (lambda (cell)
1727                       (org-export-table-cell-borders cell info))
1728                     (org-element-map tree 'table-cell 'identity)))))
1729   ;; 4. Take table rules into consideration.
1730   (org-test-with-parsed-data "
1731 | 1 |
1732 |---|
1733 | 2 |"
1734     (should
1735      (equal '((below top) (bottom above))
1736             (mapcar (lambda (cell)
1737                       (org-export-table-cell-borders cell info))
1738                     (org-element-map tree 'table-cell 'identity)))))
1739   ;; 5. Top and (resp. bottom) rules induce both `top' and `above'
1740   ;;    (resp. `bottom' and `below') borders.  Any special row is
1741   ;;    ignored.
1742   (org-test-with-parsed-data "
1743 |---+----|
1744 | / |    |
1745 |   |  1 |
1746 |---+----|"
1747     (should
1748      (equal '((bottom below top above))
1749             (last
1750              (mapcar (lambda (cell)
1751                        (org-export-table-cell-borders cell info))
1752                      (org-element-map tree 'table-cell 'identity)))))))
1753
1754 (ert-deftest test-org-export/table-dimensions ()
1755   "Test `org-export-table-dimensions' specifications."
1756   ;; 1. Standard test.
1757   (org-test-with-parsed-data "
1758 | 1 | 2 | 3 |
1759 | 4 | 5 | 6 |"
1760     (should
1761      (equal '(2 . 3)
1762             (org-export-table-dimensions
1763              (org-element-map tree 'table 'identity info 'first-match) info))))
1764   ;; 2. Ignore horizontal rules and special columns.
1765   (org-test-with-parsed-data "
1766 | / | < | > |
1767 | 1 | 2 | 3 |
1768 |---+---+---|
1769 | 4 | 5 | 6 |"
1770     (should
1771      (equal '(2 . 3)
1772             (org-export-table-dimensions
1773              (org-element-map tree 'table 'identity info 'first-match) info)))))
1774
1775 (ert-deftest test-org-export/table-cell-address ()
1776   "Test `org-export-table-cell-address' specifications."
1777   ;; 1. Standard test: index is 0-based.
1778   (org-test-with-parsed-data "| a | b |"
1779     (should
1780      (equal '((0 . 0) (0 . 1))
1781             (org-element-map
1782              tree 'table-cell
1783              (lambda (cell) (org-export-table-cell-address cell info))
1784              info))))
1785   ;; 2. Special column isn't counted, nor are special rows.
1786   (org-test-with-parsed-data "
1787 | / | <> |
1788 |   | c  |"
1789     (should
1790      (equal '(0 . 0)
1791             (org-export-table-cell-address
1792              (car (last (org-element-map tree 'table-cell 'identity info)))
1793              info))))
1794   ;; 3. Tables rules do not count either.
1795   (org-test-with-parsed-data "
1796 | a |
1797 |---|
1798 | b |
1799 |---|
1800 | c |"
1801     (should
1802      (equal '(2 . 0)
1803             (org-export-table-cell-address
1804              (car (last (org-element-map tree 'table-cell 'identity info)))
1805              info))))
1806   ;; 4. Return nil for special cells.
1807   (org-test-with-parsed-data "| / | a |"
1808     (should-not
1809      (org-export-table-cell-address
1810       (org-element-map tree 'table-cell 'identity nil 'first-match)
1811       info))))
1812
1813 (ert-deftest test-org-export/get-table-cell-at ()
1814   "Test `org-export-get-table-cell-at' specifications."
1815   ;; 1. Address ignores special columns, special rows and rules.
1816   (org-test-with-parsed-data "
1817 | / | <> |
1818 |   | a  |
1819 |---+----|
1820 |   | b  |"
1821     (should
1822      (equal '("b")
1823             (org-element-contents
1824              (org-export-get-table-cell-at
1825               '(1 . 0)
1826               (org-element-map tree 'table 'identity info 'first-match)
1827               info)))))
1828   ;; 2. Return value for a non-existent address is nil.
1829   (org-test-with-parsed-data "| a |"
1830     (should-not
1831      (org-export-get-table-cell-at
1832       '(2 . 2)
1833       (org-element-map tree 'table 'identity info 'first-match)
1834       info)))
1835   (org-test-with-parsed-data "| / |"
1836     (should-not
1837      (org-export-get-table-cell-at
1838       '(0 . 0)
1839       (org-element-map tree 'table 'identity info 'first-match)
1840       info))))
1841
1842 (ert-deftest test-org-export/table-cell-starts-colgroup-p ()
1843   "Test `org-export-table-cell-starts-colgroup-p' specifications."
1844   ;; 1. A cell at a beginning of a row always starts a column group.
1845   (org-test-with-parsed-data "| a |"
1846     (should
1847      (org-export-table-cell-starts-colgroup-p
1848       (org-element-map tree 'table-cell 'identity info 'first-match)
1849       info)))
1850   ;; 2. Special column should be ignored when determining the
1851   ;;    beginning of the row.
1852   (org-test-with-parsed-data "
1853 | / |   |
1854 |   | a |"
1855     (should
1856      (org-export-table-cell-starts-colgroup-p
1857       (org-element-map tree 'table-cell 'identity info 'first-match)
1858       info)))
1859   ;; 2. Explicit column groups.
1860   (org-test-with-parsed-data "
1861 | / |   | < |
1862 | a | b | c |"
1863     (should
1864      (equal
1865       '(yes no yes)
1866       (org-element-map
1867        tree 'table-cell
1868        (lambda (cell)
1869          (if (org-export-table-cell-starts-colgroup-p cell info) 'yes 'no))
1870        info)))))
1871
1872 (ert-deftest test-org-export/table-cell-ends-colgroup-p ()
1873   "Test `org-export-table-cell-ends-colgroup-p' specifications."
1874   ;; 1. A cell at the end of a row always ends a column group.
1875   (org-test-with-parsed-data "| a |"
1876     (should
1877      (org-export-table-cell-ends-colgroup-p
1878       (org-element-map tree 'table-cell 'identity info 'first-match)
1879       info)))
1880   ;; 2. Special column should be ignored when determining the
1881   ;;    beginning of the row.
1882   (org-test-with-parsed-data "
1883 | / |   |
1884 |   | a |"
1885     (should
1886      (org-export-table-cell-ends-colgroup-p
1887       (org-element-map tree 'table-cell 'identity info 'first-match)
1888       info)))
1889   ;; 3. Explicit column groups.
1890   (org-test-with-parsed-data "
1891 | / | < |   |
1892 | a | b | c |"
1893     (should
1894      (equal
1895       '(yes no yes)
1896       (org-element-map
1897        tree 'table-cell
1898        (lambda (cell)
1899          (if (org-export-table-cell-ends-colgroup-p cell info) 'yes 'no))
1900        info)))))
1901
1902 (ert-deftest test-org-export/table-row-starts-rowgroup-p ()
1903   "Test `org-export-table-row-starts-rowgroup-p' specifications."
1904   ;; 1. A row at the beginning of a table always starts a row group.
1905   ;;    So does a row following a table rule.
1906   (org-test-with-parsed-data "
1907 | a |
1908 |---|
1909 | b |"
1910     (should
1911      (equal
1912       '(yes no yes)
1913       (org-element-map
1914        tree 'table-row
1915        (lambda (row)
1916          (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
1917        info))))
1918   ;; 2. Special rows should be ignored when determining the beginning
1919   ;;    of the row.
1920   (org-test-with-parsed-data "
1921 | / | < |
1922 |   | a |
1923 |---+---|
1924 | / | < |
1925 |   | b |"
1926     (should
1927      (equal
1928       '(yes no yes)
1929       (org-element-map
1930        tree 'table-row
1931        (lambda (row)
1932          (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
1933        info)))))
1934
1935 (ert-deftest test-org-export/table-row-ends-rowgroup-p ()
1936   "Test `org-export-table-row-ends-rowgroup-p' specifications."
1937   ;; 1. A row at the end of a table always ends a row group.  So does
1938   ;;    a row preceding a table rule.
1939   (org-test-with-parsed-data "
1940 | a |
1941 |---|
1942 | b |"
1943     (should
1944      (equal
1945       '(yes no yes)
1946       (org-element-map
1947        tree 'table-row
1948        (lambda (row)
1949          (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
1950        info))))
1951   ;; 2. Special rows should be ignored when determining the beginning
1952   ;;    of the row.
1953   (org-test-with-parsed-data "
1954 |   | a |
1955 | / | < |
1956 |---+---|
1957 |   | b |
1958 | / | < |"
1959     (should
1960      (equal
1961       '(yes no yes)
1962       (org-element-map
1963        tree 'table-row
1964        (lambda (row)
1965          (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
1966        info)))))
1967
1968 (ert-deftest test-org-export/table-row-starts-header-p ()
1969   "Test `org-export-table-row-starts-header-p' specifications."
1970   ;; 1. Only the row starting the first row group starts the table
1971   ;;    header.
1972   (org-test-with-parsed-data "
1973 | a |
1974 | b |
1975 |---|
1976 | c |"
1977     (should
1978      (equal
1979       '(yes no no no)
1980       (org-element-map
1981        tree 'table-row
1982        (lambda (row)
1983          (if (org-export-table-row-starts-header-p row info) 'yes 'no))
1984        info))))
1985   ;; 2. A row cannot start an header if there's no header in the
1986   ;;    table.
1987   (org-test-with-parsed-data "
1988 | a |
1989 |---|"
1990     (should-not
1991      (org-export-table-row-starts-header-p
1992       (org-element-map tree 'table-row 'identity info 'first-match)
1993       info))))
1994
1995 (ert-deftest test-org-export/table-row-ends-header-p ()
1996   "Test `org-export-table-row-ends-header-p' specifications."
1997   ;; 1. Only the row starting the first row group starts the table
1998   ;;    header.
1999   (org-test-with-parsed-data "
2000 | a |
2001 | b |
2002 |---|
2003 | c |"
2004     (should
2005      (equal
2006       '(no yes no no)
2007       (org-element-map
2008        tree 'table-row
2009        (lambda (row)
2010          (if (org-export-table-row-ends-header-p row info) 'yes 'no))
2011        info))))
2012   ;; 2. A row cannot start an header if there's no header in the
2013   ;;    table.
2014   (org-test-with-parsed-data "
2015 | a |
2016 |---|"
2017     (should-not
2018      (org-export-table-row-ends-header-p
2019       (org-element-map tree 'table-row 'identity info 'first-match)
2020       info))))
2021
2022
2023 \f
2024 ;;; Topology
2025
2026 (ert-deftest test-org-export/get-next-element ()
2027   "Test `org-export-get-next-element' specifications."
2028   ;; Standard test.
2029   (should
2030    (equal "b"
2031           (org-test-with-parsed-data "* Headline\n*a* b"
2032             (org-export-get-next-element
2033              (org-element-map tree 'bold 'identity info t) info))))
2034   ;; Return nil when no previous element.
2035   (should-not
2036    (org-test-with-parsed-data "* Headline\na *b*"
2037      (org-export-get-next-element
2038       (org-element-map tree 'bold 'identity info t) info)))
2039   ;; Non-exportable elements are ignored.
2040   (should-not
2041    (let ((org-export-with-timestamps nil))
2042      (org-test-with-parsed-data "\alpha <2012-03-29 Thu>"
2043        (org-export-get-next-element
2044         (org-element-map tree 'entity 'identity info t) info))))
2045   ;; Find next element in secondary strings.
2046   (should
2047    (eq 'verbatim
2048        (org-test-with-parsed-data "* a =verb="
2049          (org-element-type
2050           (org-export-get-next-element
2051            (org-element-map tree 'plain-text 'identity info t) info)))))
2052   ;; Find next element in document keywords.
2053   (should
2054    (eq 'verbatim
2055        (org-test-with-parsed-data "#+TITLE: a =verb="
2056          (org-element-type
2057           (org-export-get-next-element
2058            (org-element-map
2059             (plist-get info :title) 'plain-text 'identity info t) info)))))
2060   ;; Find next element in parsed affiliated keywords.
2061   (should
2062    (eq 'verbatim
2063        (org-test-with-parsed-data "#+CAPTION: a =verb=\nParagraph"
2064          (org-element-type
2065           (org-export-get-next-element
2066            (org-element-map tree 'plain-text 'identity info t nil t) info))))))
2067
2068 (ert-deftest test-org-export/get-previous-element ()
2069   "Test `org-export-get-previous-element' specifications."
2070   ;; Standard test.
2071   (should
2072    (equal "a "
2073           (org-test-with-parsed-data "* Headline\na *b*"
2074             (org-export-get-previous-element
2075              (org-element-map tree 'bold 'identity info t) info))))
2076   ;; Return nil when no previous element.
2077   (should-not
2078    (org-test-with-parsed-data "* Headline\n*a* b"
2079      (org-export-get-previous-element
2080       (org-element-map tree 'bold 'identity info t) info)))
2081   ;; Non-exportable elements are ignored.
2082   (should-not
2083    (let ((org-export-with-timestamps nil))
2084      (org-test-with-parsed-data "<2012-03-29 Thu> \alpha"
2085        (org-export-get-previous-element
2086         (org-element-map tree 'entity 'identity info t) info))))
2087   ;; Find previous element in secondary strings.
2088   (should
2089    (eq 'verbatim
2090        (org-test-with-parsed-data "* =verb= a"
2091          (org-element-type
2092           (org-export-get-previous-element
2093            (org-element-map tree 'plain-text 'identity info t) info)))))
2094   ;; Find previous element in document keywords.
2095   (should
2096    (eq 'verbatim
2097        (org-test-with-parsed-data "#+TITLE: =verb= a"
2098          (org-element-type
2099           (org-export-get-previous-element
2100            (org-element-map
2101             (plist-get info :title) 'plain-text 'identity info t) info)))))
2102   ;; Find previous element in parsed affiliated keywords.
2103   (should
2104    (eq 'verbatim
2105        (org-test-with-parsed-data "#+CAPTION: =verb= a\nParagraph"
2106          (org-element-type
2107           (org-export-get-previous-element
2108            (org-element-map tree 'plain-text 'identity info t nil t) info))))))
2109
2110
2111 (provide 'test-org-export)
2112 ;;; test-org-export.el end here