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 ((,(intern (format "org-%s-translate-alist" backend))
  27           ',(let (transcode-table)
  28               (dolist (type (append org-element-all-elements
  29                                     org-element-all-objects)
  30                             transcode-table)
  31                 (push
  32                  (cons type
  33                        (lambda (obj contents info)
  34                          (funcall
  35                           (intern (format "org-element-%s-interpreter" type))
  36                           obj contents)))
  37                  transcode-table)))))
  38      (progn ,@body)))
  39
  40 (defmacro org-test-with-parsed-data (data &rest body)
  41   "Execute body with parsed data available.
  42
  43 DATA is a string containing the data to be parsed.  BODY is the
  44 body to execute.  Parse tree is available under the `tree'
  45 variable, and communication channel under `info'.
  46
  47 This function calls `org-export-collect-tree-properties'.  As
  48 such, `:ignore-list' (for `org-element-map') and
  49 `:parse-tree' (for `org-export-get-genealogy') properties are
  50 already filled in `info'."
  51   (declare (debug (form body)) (indent 1))
  52   `(org-test-with-temp-text ,data
  53      (let* ((tree (org-element-parse-buffer))
  54             (info (org-export-collect-tree-properties
  55                    tree (org-export-get-environment))))
  56        ,@body)))
  57
  58
  59 \f
  60 ;;; Tests
  61
  62 (ert-deftest test-org-export/parse-option-keyword ()
  63   "Test reading all standard #+OPTIONS: items."
  64   (should
  65    (equal
  66     (org-export--parse-option-keyword
  67      "H:1 num:t \\n:t timestamp:t arch:t author:t creator:t d:t email:t
  68  *:t e:t ::t f:t pri:t -:t ^:t toc:t |:t tags:t tasks:t <:t todo:t inline:nil
  69  stat:t")
  70     '(:headline-levels
  71       1 :preserve-breaks t :section-numbers t :time-stamp-file t
  72       :with-archived-trees t :with-author t :with-creator t :with-drawers t
  73       :with-email t :with-emphasize t :with-entities t :with-fixed-width t
  74       :with-footnotes t :with-inlinetasks nil :with-priority t
  75       :with-special-strings t :with-statistics-cookies t :with-sub-superscript t
  76       :with-toc t :with-tables t :with-tags t :with-tasks t :with-timestamps t
  77       :with-todo-keywords t)))
  78   ;; Test some special values.
  79   (should
  80    (equal
  81     (org-export--parse-option-keyword
  82      "arch:headline creator:comment d:(\"TEST\")
  83  ^:{} toc:1 tags:not-in-toc tasks:todo num:2 <:active")
  84     '( :section-numbers
  85        2
  86        :with-archived-trees headline :with-creator comment
  87        :with-drawers ("TEST") :with-sub-superscript {} :with-toc 1
  88        :with-tags not-in-toc :with-tasks todo :with-timestamps active))))
  89
  90 (ert-deftest test-org-export/get-inbuffer-options ()
  91   "Test reading all standard export keywords."
  92   (should
  93    (equal
  94     (org-test-with-temp-text "#+AUTHOR: Me, Myself and I
  95 #+CREATOR: Idem
  96 #+DATE: Today
  97 #+DESCRIPTION: Testing
  98 #+DESCRIPTION: with two lines
  99 #+EMAIL: some@email.org
 100 #+EXCLUDE_TAGS: noexport invisible
 101 #+KEYWORDS: test
 102 #+LANGUAGE: en
 103 #+SELECT_TAGS: export
 104 #+TITLE: Some title
 105 #+TITLE: with spaces"
 106       (org-export--get-inbuffer-options))
 107     '(:author
 108       ("Me, Myself and I") :creator "Idem" :date ("Today")
 109       :description "Testing\nwith two lines" :email "some@email.org"
 110       :exclude-tags ("noexport" "invisible") :keywords "test" :language "en"
 111       :select-tags ("export") :title ("Some title with spaces")))))
 112
 113 (ert-deftest test-org-export/get-subtree-options ()
 114   "Test setting options from headline's properties."
 115   ;; EXPORT_TITLE.
 116   (org-test-with-temp-text "#+TITLE: Title
 117 * Headline
 118   :PROPERTIES:
 119   :EXPORT_TITLE: Subtree Title
 120   :END:
 121 Paragraph"
 122     (forward-line)
 123     (should (equal (plist-get (org-export-get-environment nil t) :title)
 124                    '("Subtree Title"))))
 125   :title
 126   '("subtree-title")
 127   ;; EXPORT_OPTIONS.
 128   (org-test-with-temp-text "#+OPTIONS: H:1
 129 * Headline
 130   :PROPERTIES:
 131   :EXPORT_OPTIONS: H:2
 132   :END:
 133 Paragraph"
 134     (forward-line)
 135     (should
 136      (= 2 (plist-get (org-export-get-environment nil t) :headline-levels))))
 137   ;; EXPORT_DATE.
 138   (org-test-with-temp-text "#+DATE: today
 139 * Headline
 140   :PROPERTIES:
 141   :EXPORT_DATE: 29-03-2012
 142   :END:
 143 Paragraph"
 144     (forward-line)
 145     (should (equal (plist-get (org-export-get-environment nil t) :date)
 146                    '("29-03-2012"))))
 147   ;; Export properties are case-insensitive.
 148   (org-test-with-temp-text "* Headline
 149   :PROPERTIES:
 150   :EXPORT_Date: 29-03-2012
 151   :END:
 152 Paragraph"
 153     (should (equal (plist-get (org-export-get-environment nil t) :date)
 154                    '("29-03-2012")))))
 155
 156 (ert-deftest test-org-export/handle-options ()
 157   "Test if export options have an impact on output."
 158   ;; Test exclude tags.
 159   (org-test-with-temp-text "* Head1 :noexport:"
 160     (org-test-with-backend test
 161       (should
 162        (equal (org-export-as 'test nil nil nil '(:exclude-tags ("noexport")))
 163               ""))))
 164   ;; Test include tags.
 165   (org-test-with-temp-text "
 166 * Head1
 167 * Head2
 168 ** Sub-Head2.1 :export:
 169 *** Sub-Head2.1.1
 170 * Head2"
 171     (org-test-with-backend test
 172       (should
 173        (equal
 174         "* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n"
 175         (let ((org-tags-column 0))
 176           (org-export-as 'test nil nil nil '(:select-tags ("export"))))))))
 177   ;; Test mixing include tags and exclude tags.
 178   (org-test-with-temp-text "
 179 * Head1 :export:
 180 ** Sub-Head1 :noexport:
 181 ** Sub-Head2
 182 * Head2 :noexport:
 183 ** Sub-Head1 :export:"
 184     (org-test-with-backend test
 185       (should
 186        (string-match
 187         "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n"
 188         (org-export-as
 189          'test nil nil nil
 190          '(:select-tags ("export") :exclude-tags ("noexport")))))))
 191   ;; Ignore tasks.
 192   (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
 193     (org-test-with-temp-text "* TODO Head1"
 194       (org-test-with-backend test
 195         (should (equal (org-export-as 'test nil nil nil '(:with-tasks nil))
 196                        "")))))
 197   (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
 198     (org-test-with-temp-text "* TODO Head1"
 199       (org-test-with-backend test
 200         (should (equal (org-export-as 'test nil nil nil '(:with-tasks t))
 201                        "* TODO Head1\n")))))
 202   ;; Archived tree.
 203   (org-test-with-temp-text "* Head1 :archive:"
 204     (let ((org-archive-tag "archive"))
 205       (org-test-with-backend test
 206         (should
 207          (equal (org-export-as 'test nil nil nil '(:with-archived-trees nil))
 208                 "")))))
 209   (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2"
 210     (let ((org-archive-tag "archive"))
 211       (org-test-with-backend test
 212         (should
 213          (string-match
 214           "\\* Head1[ \t]+:archive:"
 215           (org-export-as 'test nil nil nil
 216                          '(:with-archived-trees headline)))))))
 217   (org-test-with-temp-text "* Head1 :archive:"
 218     (let ((org-archive-tag "archive"))
 219       (org-test-with-backend test
 220         (should
 221          (string-match
 222           "\\`\\* Head1[ \t]+:archive:\n\\'"
 223           (org-export-as 'test nil nil nil '(:with-archived-trees t)))))))
 224   ;; Drawers.
 225   (let ((org-drawers '("TEST")))
 226     (org-test-with-temp-text ":TEST:\ncontents\n:END:"
 227       (org-test-with-backend test
 228         (should (equal (org-export-as 'test nil nil nil '(:with-drawers nil))
 229                        ""))
 230         (should (equal (org-export-as 'test nil nil nil '(:with-drawers t))
 231                        ":TEST:\ncontents\n:END:\n")))))
 232   (let ((org-drawers '("FOO" "BAR")))
 233     (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
 234       (org-test-with-backend test
 235         (should
 236          (equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO")))
 237                 ":FOO:\nkeep\n:END:\n")))))
 238   ;; Timestamps.
 239   (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>"
 240     (org-test-with-backend test
 241       (should
 242        (equal (org-export-as 'test nil nil nil '(:with-timestamps t))
 243               "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n"))
 244       (should
 245        (equal (org-export-as 'test nil nil nil '(:with-timestamps nil)) ""))
 246       (should
 247        (equal (org-export-as 'test nil nil nil '(:with-timestamps active))
 248               "<2012-04-29 sun. 10:45>\n"))
 249       (should
 250        (equal (org-export-as 'test nil nil nil '(:with-timestamps inactive))
 251               "[2012-04-29 sun. 10:45]\n"))))
 252   ;; Clocks.
 253   (let ((org-clock-string "CLOCK:"))
 254     (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
 255       (org-test-with-backend test
 256         (should
 257          (equal (org-export-as 'test nil nil nil '(:with-clocks t))
 258                 "CLOCK: [2012-04-29 sun. 10:45]\n"))
 259         (should
 260          (equal (org-export-as 'test nil nil nil '(:with-clocks nil)) "")))))
 261   ;; Plannings.
 262   (let ((org-closed-string "CLOSED:"))
 263     (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
 264       (org-test-with-backend test
 265         (should
 266          (equal (org-export-as 'test nil nil nil '(:with-plannings t))
 267                 "CLOSED: [2012-04-29 sun. 10:45]\n"))
 268         (should
 269          (equal (org-export-as 'test nil nil nil '(:with-plannings nil))
 270                 "")))))
 271   ;; Inlinetasks.
 272   (when (featurep 'org-inlinetask)
 273     (should
 274      (equal
 275       (let ((org-inlinetask-min-level 15))
 276         (org-test-with-temp-text "*************** Task"
 277           (org-test-with-backend test
 278             (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
 279       ""))
 280     (should
 281      (equal
 282       (let ((org-inlinetask-min-level 15))
 283         (org-test-with-temp-text
 284             "*************** Task\nContents\n*************** END"
 285           (org-test-with-backend test
 286             (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
 287       "")))
 288   ;; Statistics cookies.
 289   (should
 290    (equal ""
 291           (org-test-with-temp-text "[0/0]"
 292             (org-test-with-backend test
 293               (org-export-as
 294                'test nil nil nil '(:with-statistics-cookies nil)))))))
 295
 296 (ert-deftest test-org-export/comment-tree ()
 297   "Test if export process ignores commented trees."
 298   (let ((org-comment-string "COMMENT"))
 299     (org-test-with-temp-text "* COMMENT Head1"
 300       (org-test-with-backend test
 301         (should (equal (org-export-as 'test) ""))))))
 302
 303 (ert-deftest test-org-export/export-scope ()
 304   "Test all export scopes."
 305   (org-test-with-temp-text "
 306 * Head1
 307 ** Head2
 308 text
 309 *** Head3"
 310     (org-test-with-backend test
 311       ;; Subtree.
 312       (forward-line 3)
 313       (should (equal (org-export-as 'test 'subtree) "text\n*** Head3\n"))
 314       ;; Visible.
 315       (goto-char (point-min))
 316       (forward-line)
 317       (org-cycle)
 318       (should (equal (org-export-as 'test nil 'visible) "* Head1\n"))
 319       ;; Body only.
 320       (flet ((org-test-template (body info) (format "BEGIN\n%sEND" body)))
 321         (push '(template . org-test-template) org-test-translate-alist)
 322         (should (equal (org-export-as 'test nil nil 'body-only)
 323                        "* Head1\n** Head2\ntext\n*** Head3\n"))
 324         (should (equal (org-export-as 'test)
 325                        "BEGIN\n* Head1\n** Head2\ntext\n*** Head3\nEND")))
 326       ;; Region.
 327       (goto-char (point-min))
 328       (forward-line 3)
 329       (transient-mark-mode 1)
 330       (push-mark (point) t t)
 331       (goto-char (point-at-eol))
 332       (should (equal (org-export-as 'test) "text\n"))))
 333   ;; Subtree with a code block calling another block outside.
 334   (org-test-with-temp-text "
 335 * Head1
 336 #+BEGIN_SRC emacs-lisp :noweb yes :exports results
 337 <<test>>
 338 #+END_SRC
 339 * Head2
 340 #+NAME: test
 341 #+BEGIN_SRC emacs-lisp
 342 \(+ 1 2)
 343 #+END_SRC"
 344     (org-test-with-backend test
 345       (forward-line 1)
 346       (should (equal (org-export-as 'test 'subtree) ": 3\n")))))
 347
 348 (ert-deftest test-org-export/expand-include ()
 349   "Test file inclusion in an Org buffer."
 350   ;; Full insertion with recursive inclusion.
 351   (org-test-with-temp-text
 352       (format "#+INCLUDE: \"%s/examples/include.org\"" org-test-dir)
 353     (org-export-expand-include-keyword)
 354     (should (equal (buffer-string)
 355                    "Small Org file with an include keyword.
 356
 357 #+BEGIN_SRC emacs-lisp :exports results\n(+ 2 1)\n#+END_SRC
 358
 359 Success!
 360
 361 * Heading
 362 body\n")))
 363   ;; Localized insertion.
 364   (org-test-with-temp-text
 365       (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\""
 366               org-test-dir)
 367     (org-export-expand-include-keyword)
 368     (should (equal (buffer-string)
 369                    "Small Org file with an include keyword.\n")))
 370   ;; Insertion with constraints on headlines level.
 371   (org-test-with-temp-text
 372       (format
 373        "* Top heading\n#+INCLUDE: \"%s/examples/include.org\" :lines \"9-\""
 374        org-test-dir)
 375     (org-export-expand-include-keyword)
 376     (should (equal (buffer-string) "* Top heading\n** Heading\nbody\n")))
 377   ;; Inclusion within an example block.
 378   (org-test-with-temp-text
 379       (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\" example"
 380               org-test-dir)
 381     (org-export-expand-include-keyword)
 382     (should
 383      (equal
 384       (buffer-string)
 385       "#+BEGIN_EXAMPLE\nSmall Org file with an include keyword.\n#+END_EXAMPLE\n")))
 386   ;; Inclusion within a src-block.
 387   (org-test-with-temp-text
 388       (format
 389        "#+INCLUDE: \"%s/examples/include.org\" :lines \"4-5\" src emacs-lisp"
 390        org-test-dir)
 391     (org-export-expand-include-keyword)
 392     (should (equal (buffer-string)
 393                    "#+BEGIN_SRC emacs-lisp\n(+ 2 1)\n#+END_SRC\n"))))
 394
 395 (ert-deftest test-org-export/user-ignore-list ()
 396   "Test if `:ignore-list' accepts user input."
 397   (org-test-with-backend test
 398     (flet ((skip-note-head
 399             (data backend info)
 400             ;; Ignore headlines with the word "note" in their title.
 401             (org-element-map
 402              data 'headline
 403              (lambda (headline)
 404                (when (string-match "\\<note\\>"
 405                                    (org-element-property :raw-value headline))
 406                  (org-export-ignore-element headline info)))
 407              info)
 408             data))
 409       ;; Install function in parse tree filters.
 410       (let ((org-export-filter-parse-tree-functions '(skip-note-head)))
 411         (org-test-with-temp-text "* Head1\n* Head2 (note)\n"
 412           (should (equal (org-export-as 'test) "* Head1\n")))))))
 413
 414 (ert-deftest test-org-export/before-parsing-hook ()
 415   "Test `org-export-before-parsing-hook'."
 416   (org-test-with-backend test
 417     (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody 2"
 418       (let ((org-export-before-parsing-hook
 419              '((lambda (backend)
 420                  (org-map-entries
 421                   (lambda ()
 422                     (delete-region (point) (progn (forward-line) (point)))))))))
 423         (should (equal (org-export-as 'test) "Body 1\nBody 2\n"))))))
 424
 425
 426 \f
 427 ;;; Affiliated Keywords
 428
 429 (ert-deftest test-org-export/read-attribute ()
 430   "Test `org-export-read-attribute' specifications."
 431   ;; Standard test.
 432   (should
 433    (equal
 434     (org-export-read-attribute
 435      :attr_html
 436      (org-test-with-temp-text "#+ATTR_HTML: :a 1 :b 2\nParagraph"
 437        (org-element-at-point)))
 438     '(:a 1 :b 2)))
 439   ;; Return nil on empty attribute.
 440   (should-not
 441    (org-export-read-attribute
 442     :attr_html
 443     (org-test-with-temp-text "Paragraph" (org-element-at-point)))))
 444
 445
 446 \f
 447 ;;; Export Snippets
 448
 449 (ert-deftest test-org-export/export-snippet ()
 450   "Test export snippets transcoding."
 451   (org-test-with-temp-text "@@test:A@@@@t:B@@"
 452     (org-test-with-backend test
 453       (let ((org-test-translate-alist
 454              (cons (cons 'export-snippet
 455                          (lambda (snippet contents info)
 456                            (when (eq (org-export-snippet-backend snippet) 'test)
 457                              (org-element-property :value snippet))))
 458                    org-test-translate-alist)))
 459         (let ((org-export-snippet-translation-alist nil))
 460           (should (equal (org-export-as 'test) "A\n")))
 461         (let ((org-export-snippet-translation-alist '(("t" . "test"))))
 462           (should (equal (org-export-as 'test) "AB\n")))))))
 463
 464
 465 \f
 466 ;;; Footnotes
 467
 468 (ert-deftest test-org-export/footnotes ()
 469   "Test footnotes specifications."
 470   (let ((org-footnote-section nil)
 471         (org-export-with-footnotes t))
 472     ;; 1. Read every type of footnote.
 473     (should
 474      (equal
 475       '((1 . "A\n") (2 . "B") (3 . "C") (4 . "D"))
 476       (org-test-with-parsed-data
 477           "Text[fn:1] [1] [fn:label:C] [fn::D]\n\n[fn:1] A\n\n[1] B"
 478         (org-element-map
 479          tree 'footnote-reference
 480          (lambda (ref)
 481            (let ((def (org-export-get-footnote-definition ref info)))
 482              (cons (org-export-get-footnote-number ref info)
 483                    (if (eq (org-element-property :type ref) 'inline) (car def)
 484                      (car (org-element-contents
 485                            (car (org-element-contents def))))))))
 486          info))))
 487     ;; 2. Test nested footnotes order.
 488     (org-test-with-parsed-data
 489         "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C."
 490       (should
 491        (equal
 492         '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4))
 493         (org-element-map
 494          tree 'footnote-reference
 495          (lambda (ref)
 496            (when (org-export-footnote-first-reference-p ref info)
 497              (cons (org-export-get-footnote-number ref info)
 498                    (org-element-property :label ref))))
 499          info))))
 500     ;; 3. Test nested footnote in invisible definitions.
 501     (org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C."
 502       ;; Hide definitions.
 503       (narrow-to-region (point) (point-at-eol))
 504       (let* ((tree (org-element-parse-buffer))
 505              (info (org-combine-plists
 506                     `(:parse-tree ,tree)
 507                     (org-export-collect-tree-properties
 508                      tree (org-export-get-environment)))))
 509         ;; Both footnotes should be seen.
 510         (should
 511          (= (length (org-export-collect-footnote-definitions tree info)) 2))))
 512     ;; 4. Test footnotes definitions collection.
 513     (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3].
 514
 515 \[fn:2] B [fn:3] [fn::D].
 516
 517 \[fn:3] C."
 518       (should (= (length (org-export-collect-footnote-definitions tree info))
 519                  4)))
 520     ;; 5. Test export of footnotes defined outside parsing scope.
 521     (org-test-with-temp-text "[fn:1] Out of scope
 522 * Title
 523 Paragraph[fn:1]"
 524       (org-test-with-backend test
 525         (let ((org-test-translate-alist
 526                (cons (cons 'footnote-reference
 527                            (lambda (fn contents info)
 528                              (org-element-interpret-data
 529                               (org-export-get-footnote-definition fn info))))
 530                      org-test-translate-alist)))
 531           (forward-line)
 532           (should (equal "ParagraphOut of scope\n"
 533                          (org-export-as 'test 'subtree))))))))
 534
 535
 536 \f
 537 ;;; Headlines and Inlinetasks
 538
 539 (ert-deftest test-org-export/get-relative-level ()
 540   "Test `org-export-get-relative-level' specifications."
 541   ;; Standard test.
 542   (should
 543    (equal '(1 2)
 544           (let ((org-odd-levels-only nil))
 545             (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 546               (org-element-map
 547                tree 'headline
 548                (lambda (h) (org-export-get-relative-level h info))
 549                info)))))
 550   ;; Missing levels
 551   (should
 552    (equal '(1 3)
 553           (let ((org-odd-levels-only nil))
 554             (org-test-with-parsed-data "** Headline 1\n**** Headline 2"
 555               (org-element-map
 556                tree 'headline
 557                (lambda (h) (org-export-get-relative-level h info))
 558                info))))))
 559
 560 (ert-deftest test-org-export/low-level-p ()
 561   "Test `org-export-low-level-p' specifications."
 562   (should
 563    (equal
 564     '(no yes)
 565     (let ((org-odd-levels-only nil))
 566       (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 567         (org-element-map
 568          tree 'headline
 569          (lambda (h) (if (org-export-low-level-p h info) 'yes 'no))
 570          (plist-put info :headline-levels 1)))))))
 571
 572 (ert-deftest test-org-export/get-headline-number ()
 573   "Test `org-export-get-headline-number' specifications."
 574   ;; Standard test.
 575   (should
 576    (equal
 577     '((1) (1 1))
 578     (let ((org-odd-levels-only nil))
 579       (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 580         (org-element-map
 581          tree 'headline
 582          (lambda (h) (org-export-get-headline-number h info))
 583          info)))))
 584   ;; Missing levels are replaced with 0.
 585   (should
 586    (equal
 587     '((1) (1 0 1))
 588     (let ((org-odd-levels-only nil))
 589       (org-test-with-parsed-data "* Headline 1\n*** Headline 2"
 590         (org-element-map
 591          tree 'headline
 592          (lambda (h) (org-export-get-headline-number h info))
 593          info))))))
 594
 595 (ert-deftest test-org-export/numbered-headline-p ()
 596   "Test `org-export-numbered-headline-p' specifications."
 597   ;; If `:section-numbers' is nil, never number headlines.
 598   (should-not
 599    (org-test-with-parsed-data "* Headline"
 600      (org-element-map
 601       tree 'headline
 602       (lambda (h) (org-export-numbered-headline-p h info))
 603       (plist-put info :section-numbers nil))))
 604   ;; If `:section-numbers' is a number, only number headlines with
 605   ;; a level greater that it.
 606   (should
 607    (equal
 608     '(yes no)
 609     (org-test-with-parsed-data "* Headline 1\n** Headline 2"
 610       (org-element-map
 611        tree 'headline
 612        (lambda (h) (if (org-export-numbered-headline-p h info) 'yes 'no))
 613        (plist-put info :section-numbers 1)))))
 614   ;; Otherwise, headlines are always numbered.
 615   (should
 616    (org-test-with-parsed-data "* Headline"
 617      (org-element-map
 618       tree 'headline
 619       (lambda (h) (org-export-numbered-headline-p h info))
 620       (plist-put info :section-numbers t)))))
 621
 622 (ert-deftest test-org-export/number-to-roman ()
 623   "Test `org-export-number-to-roman' specifications."
 624   ;; If number is negative, return it as a string.
 625   (should (equal (org-export-number-to-roman -1) "-1"))
 626   ;; Otherwise, return it as a roman number.
 627   (should (equal (org-export-number-to-roman 1449) "MCDXLIX")))
 628
 629 (ert-deftest test-org-export/get-tags ()
 630   "Test `org-export-get-tags' specifications."
 631   (let ((org-export-exclude-tags '("noexport"))
 632         (org-export-select-tags '("export")))
 633     ;; Standard test: tags which are not a select tag, an exclude tag,
 634     ;; or specified as optional argument shouldn't be ignored.
 635     (should
 636      (org-test-with-parsed-data "* Headline :tag:"
 637        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 638                             info)))
 639     ;; Exclude tags are removed.
 640     (should-not
 641      (org-test-with-parsed-data "* Headline :noexport:"
 642        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 643                             info)))
 644     ;; Select tags are removed.
 645     (should-not
 646      (org-test-with-parsed-data "* Headline :export:"
 647        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 648                             info)))
 649     (should
 650      (equal
 651       '("tag")
 652       (org-test-with-parsed-data "* Headline :tag:export:"
 653         (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 654                              info))))
 655     ;; Tags provided in the optional argument are also ignored.
 656     (should-not
 657      (org-test-with-parsed-data "* Headline :ignore:"
 658        (org-export-get-tags (org-element-map tree 'headline 'identity info t)
 659                             info '("ignore"))))))
 660
 661 (ert-deftest test-org-export/first-sibling-p ()
 662   "Test `org-export-first-sibling-p' specifications."
 663   ;; Standard test.
 664   (should
 665    (equal
 666     '(yes yes no)
 667     (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3"
 668       (org-element-map
 669        tree 'headline
 670        (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no))
 671        info))))
 672   ;; Ignore headlines not exported.
 673   (should
 674    (equal
 675     '(yes)
 676     (let ((org-export-exclude-tags '("ignore")))
 677       (org-test-with-parsed-data "* Headline :ignore:\n* Headline 2"
 678         (org-element-map
 679          tree 'headline
 680          (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no))
 681          info))))))
 682
 683 (ert-deftest test-org-export/last-sibling-p ()
 684   "Test `org-export-last-sibling-p' specifications."
 685   ;; Standard test.
 686   (should
 687    (equal
 688     '(yes no yes)
 689     (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3"
 690       (org-element-map
 691        tree 'headline
 692        (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no))
 693        info))))
 694   ;; Ignore headlines not exported.
 695   (should
 696    (equal
 697     '(yes)
 698     (let ((org-export-exclude-tags '("ignore")))
 699       (org-test-with-parsed-data "* Headline\n* Headline 2 :ignore:"
 700         (org-element-map
 701          tree 'headline
 702          (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no))
 703          info))))))
 704
 705
 706 \f
 707 ;;; Links
 708
 709 (ert-deftest test-org-export/get-coderef-format ()
 710   "Test `org-export-get-coderef-format' specifications."
 711   ;; A link without description returns "%s"
 712   (should (equal (org-export-get-coderef-format "(ref:line)" nil)
 713                  "%s"))
 714   ;; Return "%s" when path is matched within description.
 715   (should (equal (org-export-get-coderef-format "path" "desc (path)")
 716                  "desc %s"))
 717   ;; Otherwise return description.
 718   (should (equal (org-export-get-coderef-format "path" "desc")
 719                  "desc")))
 720
 721 (ert-deftest test-org-export/inline-image-p ()
 722   "Test `org-export-inline-image-p' specifications."
 723   (should
 724    (org-export-inline-image-p
 725     (org-test-with-temp-text "[[#id]]"
 726       (org-element-map
 727        (org-element-parse-buffer) 'link 'identity nil t))
 728     '(("custom-id" . "id")))))
 729
 730 (ert-deftest test-org-export/fuzzy-link ()
 731   "Test fuzzy links specifications."
 732   ;; 1. Links to invisible (keyword) targets should be ignored.
 733   (org-test-with-parsed-data
 734       "Paragraph.\n#+TARGET: Test\n[[Test]]"
 735     (should-not
 736      (org-element-map
 737       tree 'link
 738       (lambda (link)
 739         (org-export-get-ordinal
 740          (org-export-resolve-fuzzy-link link info) info)) info)))
 741   ;; 2. Link to an headline should return headline's number.
 742   (org-test-with-parsed-data
 743       "Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
 744     (should
 745      ;; Note: Headline's number is in fact a list of numbers.
 746      (equal '(2)
 747             (org-element-map
 748              tree 'link
 749              (lambda (link)
 750                (org-export-get-ordinal
 751                 (org-export-resolve-fuzzy-link link info) info)) info t))))
 752   ;; 3. Link to a target in an item should return item's number.
 753   (org-test-with-parsed-data
 754       "- Item1\n  - Item11\n  - <<test>>Item12\n- Item2\n\n\n[[test]]"
 755     (should
 756      ;; Note: Item's number is in fact a list of numbers.
 757      (equal '(1 2)
 758             (org-element-map
 759              tree 'link
 760              (lambda (link)
 761                (org-export-get-ordinal
 762                 (org-export-resolve-fuzzy-link link info) info)) info t))))
 763   ;; 4. Link to a target in a footnote should return footnote's
 764   ;;    number.
 765   (org-test-with-parsed-data "
 766 Paragraph[1][2][fn:lbl3:C<<target>>][[test]][[target]]\n[1] A\n\n[2] <<test>>B"
 767     (should
 768      (equal '(2 3)
 769             (org-element-map
 770              tree 'link
 771              (lambda (link)
 772                (org-export-get-ordinal
 773                 (org-export-resolve-fuzzy-link link info) info)) info))))
 774   ;; 5. Link to a named element should return sequence number of that
 775   ;;    element.
 776   (org-test-with-parsed-data
 777       "#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
 778     (should
 779      (= 2
 780         (org-element-map
 781          tree 'link
 782          (lambda (link)
 783            (org-export-get-ordinal
 784             (org-export-resolve-fuzzy-link link info) info)) info t))))
 785   ;; 6. Link to a target not within an item, a table, a footnote
 786   ;;    reference or definition should return section number.
 787   (org-test-with-parsed-data
 788       "* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
 789     (should
 790      (equal '(2)
 791             (org-element-map
 792              tree 'link
 793              (lambda (link)
 794                (org-export-get-ordinal
 795                 (org-export-resolve-fuzzy-link link info) info)) info t)))))
 796
 797 (ert-deftest test-org-export/resolve-coderef ()
 798   "Test `org-export-resolve-coderef' specifications."
 799   (let ((org-coderef-label-format "(ref:%s)"))
 800     ;; 1. A link to a "-n -k -r" block returns line number.
 801     (org-test-with-parsed-data
 802         "#+BEGIN_EXAMPLE -n -k -r\nText (ref:coderef)\n#+END_EXAMPLE"
 803       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 804     (org-test-with-parsed-data
 805         "#+BEGIN_SRC emacs-lisp -n -k -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
 806       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 807     ;; 2. A link to a "-n -r" block returns line number.
 808     (org-test-with-parsed-data
 809         "#+BEGIN_EXAMPLE -n -r\nText (ref:coderef)\n#+END_EXAMPLE"
 810       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 811     (org-test-with-parsed-data
 812         "#+BEGIN_SRC emacs-lisp -n -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
 813       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 814     ;; 3. A link to a "-n" block returns coderef.
 815     (org-test-with-parsed-data
 816         "#+BEGIN_SRC emacs-lisp -n\n(+ 1 1) (ref:coderef)\n#+END_SRC"
 817       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
 818     (org-test-with-parsed-data
 819         "#+BEGIN_EXAMPLE -n\nText (ref:coderef)\n#+END_EXAMPLE"
 820       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
 821     ;; 4. A link to a "-r" block returns line number.
 822     (org-test-with-parsed-data
 823         "#+BEGIN_SRC emacs-lisp -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
 824       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 825     (org-test-with-parsed-data
 826         "#+BEGIN_EXAMPLE -r\nText (ref:coderef)\n#+END_EXAMPLE"
 827       (should (= (org-export-resolve-coderef "coderef" info) 1)))
 828     ;; 5. A link to a block without a switch returns coderef.
 829     (org-test-with-parsed-data
 830         "#+BEGIN_SRC emacs-lisp\n(+ 1 1) (ref:coderef)\n#+END_SRC"
 831       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
 832     (org-test-with-parsed-data
 833         "#+BEGIN_EXAMPLE\nText (ref:coderef)\n#+END_EXAMPLE"
 834       (should (equal (org-export-resolve-coderef "coderef" info) "coderef")))
 835     ;; 6. Correctly handle continued line numbers.  A "+n" switch
 836     ;;    should resume numbering from previous block with numbered
 837     ;;    lines, ignoring blocks not numbering lines in the process.
 838     ;;    A "-n" switch resets count.
 839     (org-test-with-parsed-data "
 840 #+BEGIN_EXAMPLE -n
 841 Text.
 842 #+END_EXAMPLE
 843
 844 #+BEGIN_SRC emacs-lisp
 845 \(- 1 1)
 846 #+END_SRC
 847
 848 #+BEGIN_SRC emacs-lisp +n -r
 849 \(+ 1 1) (ref:addition)
 850 #+END_SRC
 851
 852 #+BEGIN_EXAMPLE -n -r
 853 Another text. (ref:text)
 854 #+END_EXAMPLE"
 855       (should (= (org-export-resolve-coderef "addition" info) 2))
 856       (should (= (org-export-resolve-coderef "text" info) 1)))
 857     ;; 7. Recognize coderef with user-specified syntax.
 858     (org-test-with-parsed-data
 859         "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\nText. [ref:text]\n#+END_EXAMPLE"
 860       (should (equal (org-export-resolve-coderef "text" info) "text")))))
 861
 862 (ert-deftest test-org-export/resolve-fuzzy-link ()
 863   "Test `org-export-resolve-fuzzy-link' specifications."
 864   ;; 1. Match target objects.
 865   (org-test-with-parsed-data "<<target>> [[target]]"
 866     (should
 867      (org-export-resolve-fuzzy-link
 868       (org-element-map tree 'link 'identity info t) info)))
 869   ;; 2. Match target elements.
 870   (org-test-with-parsed-data "#+TARGET: target\n[[target]]"
 871     (should
 872      (org-export-resolve-fuzzy-link
 873       (org-element-map tree 'link 'identity info t) info)))
 874   ;; 3. Match named elements.
 875   (org-test-with-parsed-data "#+NAME: target\nParagraph\n\n[[target]]"
 876     (should
 877      (org-export-resolve-fuzzy-link
 878       (org-element-map tree 'link 'identity info t) info)))
 879   ;; 4. Match exact headline's name.
 880   (org-test-with-parsed-data "* My headline\n[[My headline]]"
 881     (should
 882      (org-export-resolve-fuzzy-link
 883       (org-element-map tree 'link 'identity info t) info)))
 884   ;; 5. Targets objects have priority over named elements and headline
 885   ;;    titles.
 886   (org-test-with-parsed-data
 887       "* target\n#+NAME: target\n<<target>>\n\n[[target]]"
 888     (should
 889      (eq 'target
 890          (org-element-type
 891           (org-export-resolve-fuzzy-link
 892            (org-element-map tree 'link 'identity info t) info)))))
 893   ;; 6. Named elements have priority over headline titles.
 894   (org-test-with-parsed-data
 895       "* target\n#+NAME: target\nParagraph\n\n[[target]]"
 896     (should
 897      (eq 'paragraph
 898          (org-element-type
 899           (org-export-resolve-fuzzy-link
 900            (org-element-map tree 'link 'identity info t) info)))))
 901   ;; 7. If link's path starts with a "*", only match headline titles,
 902   ;;    though.
 903   (org-test-with-parsed-data
 904       "* target\n#+NAME: target\n<<target>>\n\n[[*target]]"
 905     (should
 906      (eq 'headline
 907          (org-element-type
 908           (org-export-resolve-fuzzy-link
 909            (org-element-map tree 'link 'identity info t) info)))))
 910   ;; 8. Return nil if no match.
 911   (org-test-with-parsed-data "[[target]]"
 912     (should-not
 913      (org-export-resolve-fuzzy-link
 914       (org-element-map tree 'link 'identity info t) info))))
 915
 916 (ert-deftest test-org-export/resolve-id-link ()
 917   "Test `org-export-resolve-id-link' specifications."
 918   ;; 1. Regular test for custom-id link.
 919   (org-test-with-parsed-data "* Headline1
 920 :PROPERTIES:
 921 :CUSTOM-ID: test
 922 :END:
 923 * Headline 2
 924 \[[#test]]"
 925     (should
 926      (org-export-resolve-id-link
 927       (org-element-map tree 'link 'identity info t) info)))
 928   ;; 2. Failing test for custom-id link.
 929   (org-test-with-parsed-data "* Headline1
 930 :PROPERTIES:
 931 :CUSTOM-ID: test
 932 :END:
 933 * Headline 2
 934 \[[#no-match]]"
 935     (should-not
 936      (org-export-resolve-id-link
 937       (org-element-map tree 'link 'identity info t) info)))
 938   ;; 3. Test for internal id target.
 939   (org-test-with-parsed-data "* Headline1
 940 :PROPERTIES:
 941 :ID: aaaa
 942 :END:
 943 * Headline 2
 944 \[[id:aaaa]]"
 945     (should
 946      (org-export-resolve-id-link
 947       (org-element-map tree 'link 'identity info t) info)))
 948   ;; 4. Test for external id target.
 949   (org-test-with-parsed-data "[[id:aaaa]]"
 950     (should
 951      (org-export-resolve-id-link
 952       (org-element-map tree 'link 'identity info t)
 953       (org-combine-plists info '(:id-alist (("aaaa" . "external-file"))))))))
 954
 955 (ert-deftest test-org-export/resolve-radio-link ()
 956   "Test `org-export-resolve-radio-link' specifications."
 957   ;; Standard test.
 958   (org-test-with-temp-text "<<<radio>>> radio"
 959     (org-update-radio-target-regexp)
 960     (should
 961      (let* ((tree (org-element-parse-buffer))
 962             (info `(:parse-tree ,tree)))
 963        (org-export-resolve-radio-link
 964         (org-element-map tree 'link 'identity info t)
 965         info))))
 966   ;; Radio target with objects.
 967   (org-test-with-temp-text "<<<radio \\alpha>>> radio \\alpha"
 968     (org-update-radio-target-regexp)
 969     (should
 970      (let* ((tree (org-element-parse-buffer))
 971             (info `(:parse-tree ,tree)))
 972        (org-export-resolve-radio-link
 973         (org-element-map tree 'link 'identity info t)
 974         info)))))
 975
 976
 977 \f
 978 ;;; Macro
 979
 980 (ert-deftest test-org-export/define-macro ()
 981   "Try defining various Org macro using in-buffer #+MACRO: keyword."
 982   ;; Parsed macro.
 983   (should (equal (org-test-with-temp-text "#+MACRO: one 1"
 984                    (org-export--get-inbuffer-options))
 985                  '(:macro-one ("1"))))
 986   ;; Evaled macro.
 987   (should (equal (org-test-with-temp-text "#+MACRO: two (eval (+ 1 1))"
 988                    (org-export--get-inbuffer-options))
 989                  '(:macro-two ("(eval (+ 1 1))"))))
 990   ;; Incomplete macro.
 991   (should-not (org-test-with-temp-text "#+MACRO: three"
 992                 (org-export--get-inbuffer-options)))
 993   ;; Macro with newline character.
 994   (should (equal (org-test-with-temp-text "#+MACRO: four a\\nb"
 995                    (org-export--get-inbuffer-options))
 996                  '(:macro-four ("a\nb"))))
 997   ;; Macro with protected newline character.
 998   (should (equal (org-test-with-temp-text "#+MACRO: five a\\\\nb"
 999                    (org-export--get-inbuffer-options))
1000                  '(:macro-five ("a\\nb"))))
1001   ;; Recursive macro.
1002   (org-test-with-temp-text "#+MACRO: six 6\n#+MACRO: seven 1 + {{{six}}}"
1003     (should
1004      (equal
1005       (org-export--get-inbuffer-options)
1006       '(:macro-six
1007         ("6")
1008         :macro-seven
1009         ("1 + " (macro (:key "six" :value "{{{six}}}" :args nil :begin 5 :end 14
1010                              :post-blank 0 :parent nil))))))))
1011
1012 (ert-deftest test-org-export/expand-macro ()
1013   "Test `org-export-expand-macro' specifications."
1014   ;; Standard test.
1015   (should
1016    (equal
1017     "some text"
1018     (org-test-with-parsed-data "#+MACRO: macro some text\n{{{macro}}}"
1019       (org-export-expand-macro
1020        (org-element-map tree 'macro 'identity info t) info))))
1021   ;; Macro with arguments.
1022   (should
1023    (equal
1024     "some text"
1025     (org-test-with-parsed-data "#+MACRO: macro $1 $2\n{{{macro(some,text)}}}"
1026       (org-export-expand-macro
1027        (org-element-map tree 'macro 'identity info t) info))))
1028   ;; Macro with "eval"
1029   (should
1030    (equal
1031     "3"
1032     (org-test-with-parsed-data "#+MACRO: add (eval (+ $1 $2))\n{{{add(1,2)}}}"
1033       (org-export-expand-macro
1034        (org-element-map tree 'macro 'identity info t) info))))
1035   ;; Nested macros.
1036   (should
1037    (equal
1038     "inner outer"
1039     (org-test-with-parsed-data
1040         "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\n{{{out}}}"
1041       (flet ((translate-macro (macro contents info)
1042                               (org-export-expand-macro macro info)))
1043         (org-export-expand-macro
1044          (org-element-map tree 'macro 'identity info t)
1045          (org-combine-plists
1046           info `(:translate-alist ((macro . translate-macro))))))))))
1047
1048
1049 \f
1050 ;;; Src-block and example-block
1051
1052 (ert-deftest test-org-export/unravel-code ()
1053   "Test `org-export-unravel-code' function."
1054   (let ((org-coderef-label-format "(ref:%s)"))
1055     ;; 1. Code without reference.
1056     (org-test-with-temp-text "#+BEGIN_EXAMPLE\n(+ 1 1)\n#+END_EXAMPLE"
1057       (should (equal (org-export-unravel-code (org-element-at-point))
1058                      '("(+ 1 1)\n"))))
1059     ;; 2. Code with reference.
1060     (org-test-with-temp-text
1061         "#+BEGIN_EXAMPLE\n(+ 1 1) (ref:test)\n#+END_EXAMPLE"
1062       (should (equal (org-export-unravel-code (org-element-at-point))
1063                      '("(+ 1 1)\n" (1 . "test")))))
1064     ;; 3. Code with user-defined reference.
1065     (org-test-with-temp-text
1066         "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\n(+ 1 1) [ref:test]\n#+END_EXAMPLE"
1067       (should (equal (org-export-unravel-code (org-element-at-point))
1068                      '("(+ 1 1)\n" (1 . "test")))))
1069     ;; 4. Code references keys are relative to the current block.
1070     (org-test-with-temp-text "
1071 #+BEGIN_EXAMPLE -n
1072 \(+ 1 1)
1073 #+END_EXAMPLE
1074 #+BEGIN_EXAMPLE +n
1075 \(+ 2 2)
1076 \(+ 3 3) (ref:one)
1077 #+END_EXAMPLE"
1078       (goto-line 5)
1079       (should (equal (org-export-unravel-code (org-element-at-point))
1080                      '("(+ 2 2)\n(+ 3 3)\n" (2 . "one")))))
1081     ;; 5. Free up comma-protected lines.
1082     ;;
1083     ;; 5.1. In an Org source block, every line is protected.
1084     (org-test-with-temp-text
1085         "#+BEGIN_SRC org\n,* Test\n,# comment\n,Text\n#+END_SRC"
1086       (should (equal (org-export-unravel-code (org-element-at-point))
1087                      '("* Test\n# comment\nText\n"))))
1088     ;; 5.2. In other blocks, only headlines, comments and keywords are
1089     ;;      protected.
1090     (org-test-with-temp-text
1091         "#+BEGIN_EXAMPLE\n,* Headline\n, * Not headline\n,Keep\n#+END_EXAMPLE"
1092       (should (equal (org-export-unravel-code (org-element-at-point))
1093                      '("* Headline\n, * Not headline\n,Keep\n"))))))
1094
1095
1096 \f
1097 ;;; Tables
1098
1099 (ert-deftest test-org-export/special-column ()
1100   "Test if the table's special column is properly recognized."
1101   ;; 1. First column is special if it contains only a special marking
1102   ;;    characters or empty cells.
1103   (org-test-with-temp-text "
1104 | ! | 1 |
1105 |   | 2 |"
1106     (should
1107      (org-export-table-has-special-column-p
1108       (org-element-map
1109        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1110   ;; 2. If the column contains anything else, it isn't special.
1111   (org-test-with-temp-text "
1112 | ! | 1 |
1113 | b | 2 |"
1114     (should-not
1115      (org-export-table-has-special-column-p
1116       (org-element-map
1117        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1118   ;; 3. Special marking characters are "#", "^", "*", "_", "/", "$"
1119   ;;    and "!".
1120   (org-test-with-temp-text "
1121 | # | 1 |
1122 | ^ | 2 |
1123 | * | 3 |
1124 | _ | 4 |
1125 | / | 5 |
1126 | $ | 6 |
1127 | ! | 7 |"
1128     (should
1129      (org-export-table-has-special-column-p
1130       (org-element-map
1131        (org-element-parse-buffer) 'table 'identity nil 'first-match))))
1132   ;; 4. A first column with only empty cells isn't considered as
1133   ;;    special.
1134   (org-test-with-temp-text "
1135 |   | 1 |
1136 |   | 2 |"
1137     (should-not
1138      (org-export-table-has-special-column-p
1139       (org-element-map
1140        (org-element-parse-buffer) 'table 'identity nil 'first-match)))))
1141
1142 (ert-deftest test-org-export/table-row-is-special-p ()
1143   "Test `org-export-table-row-is-special-p' specifications."
1144   ;; 1. A row is special if it has a special marking character in the
1145   ;;    special column.
1146   (org-test-with-parsed-data "| ! | 1 |"
1147     (should
1148      (org-export-table-row-is-special-p
1149       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1150   ;; 2. A row is special when its first field is "/"
1151   (org-test-with-parsed-data "
1152 | / | 1 |
1153 | a | b |"
1154     (should
1155      (org-export-table-row-is-special-p
1156       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1157   ;; 3. A row only containing alignment cookies is also considered as
1158   ;;    special.
1159   (org-test-with-parsed-data "| <5> |   | <l> | <l22> |"
1160     (should
1161      (org-export-table-row-is-special-p
1162       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1163   ;; 4. Everything else isn't considered as special.
1164   (org-test-with-parsed-data "| \alpha |   | c |"
1165     (should-not
1166      (org-export-table-row-is-special-p
1167       (org-element-map tree 'table-row 'identity nil 'first-match) info)))
1168   ;; 5. Table's rules are never considered as special rows.
1169   (org-test-with-parsed-data "|---+---|"
1170     (should-not
1171      (org-export-table-row-is-special-p
1172       (org-element-map tree 'table-row 'identity nil 'first-match) info))))
1173
1174 (ert-deftest test-org-export/has-header-p ()
1175   "Test `org-export-table-has-header-p' specifications."
1176   ;; 1. With an header.
1177   (org-test-with-parsed-data "
1178 | a | b |
1179 |---+---|
1180 | c | d |"
1181     (should
1182      (org-export-table-has-header-p
1183       (org-element-map tree 'table 'identity info 'first-match)
1184       info)))
1185   ;; 2. Without an header.
1186   (org-test-with-parsed-data "
1187 | a | b |
1188 | c | d |"
1189     (should-not
1190      (org-export-table-has-header-p
1191       (org-element-map tree 'table 'identity info 'first-match)
1192       info)))
1193   ;; 3. Don't get fooled with starting and ending rules.
1194   (org-test-with-parsed-data "
1195 |---+---|
1196 | a | b |
1197 | c | d |
1198 |---+---|"
1199     (should-not
1200      (org-export-table-has-header-p
1201       (org-element-map tree 'table 'identity info 'first-match)
1202       info))))
1203
1204 (ert-deftest test-org-export/table-row-group ()
1205   "Test `org-export-table-row-group' specifications."
1206   ;; 1. A rule creates a new group.
1207   (org-test-with-parsed-data "
1208 | a | b |
1209 |---+---|
1210 | 1 | 2 |"
1211     (should
1212      (equal
1213       '(1 nil 2)
1214       (mapcar (lambda (row) (org-export-table-row-group row info))
1215               (org-element-map tree 'table-row 'identity)))))
1216   ;; 2. Special rows are ignored in count.
1217   (org-test-with-parsed-data "
1218 | / | < | > |
1219 |---|---+---|
1220 |   | 1 | 2 |"
1221     (should
1222      (equal
1223       '(nil nil 1)
1224       (mapcar (lambda (row) (org-export-table-row-group row info))
1225               (org-element-map tree 'table-row 'identity)))))
1226   ;; 3. Double rules also are ignored in count.
1227   (org-test-with-parsed-data "
1228 | a | b |
1229 |---+---|
1230 |---+---|
1231 | 1 | 2 |"
1232     (should
1233      (equal
1234       '(1 nil nil 2)
1235       (mapcar (lambda (row) (org-export-table-row-group row info))
1236               (org-element-map tree 'table-row 'identity))))))
1237
1238 (ert-deftest test-org-export/table-cell-width ()
1239   "Test `org-export-table-cell-width' specifications."
1240   ;; 1. Width is primarily determined by width cookies.  If no cookie
1241   ;;    is found, cell's width is nil.
1242   (org-test-with-parsed-data "
1243 | / | <l> | <6> | <l7> |
1244 |   |  a  |  b  |  c   |"
1245     (should
1246      (equal
1247       '(nil 6 7)
1248       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1249               (org-element-map tree 'table-cell 'identity info)))))
1250   ;; 2. The last width cookie has precedence.
1251   (org-test-with-parsed-data "
1252 | <6> |
1253 | <7> |
1254 |  a  |"
1255     (should
1256      (equal
1257       '(7)
1258       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1259               (org-element-map tree 'table-cell 'identity info)))))
1260   ;; 3. Valid width cookies must have a specific row.
1261   (org-test-with-parsed-data "| <6> | cell |"
1262     (should
1263      (equal
1264       '(nil nil)
1265       (mapcar (lambda (cell) (org-export-table-cell-width cell info))
1266               (org-element-map tree 'table-cell 'identity))))))
1267
1268 (ert-deftest test-org-export/table-cell-alignment ()
1269   "Test `org-export-table-cell-alignment' specifications."
1270   (let ((org-table-number-fraction 0.5)
1271         (org-table-number-regexp "^[0-9]+$"))
1272     ;; 1. Alignment is primarily determined by alignment cookies.
1273     (org-test-with-temp-text "| <l> | <c> | <r> |"
1274       (let* ((tree (org-element-parse-buffer))
1275              (info `(:parse-tree ,tree)))
1276         (should
1277          (equal
1278           '(left center right)
1279           (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
1280                   (org-element-map tree 'table-cell 'identity))))))
1281     ;; 2. The last alignment cookie has precedence.
1282     (org-test-with-parsed-data "
1283 | <l8> |
1284 | cell |
1285 | <r9> |"
1286       (should
1287        (equal
1288         '(right right right)
1289         (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
1290                 (org-element-map tree 'table-cell 'identity)))))
1291     ;; 3. If there's no cookie, cell's contents determine alignment.
1292     ;;    A column mostly made of cells containing numbers will align
1293     ;;    its cells to the right.
1294     (org-test-with-parsed-data "
1295 | 123       |
1296 | some text |
1297 | 12345     |"
1298       (should
1299        (equal
1300         '(right right right)
1301         (mapcar (lambda (cell)
1302                   (org-export-table-cell-alignment cell info))
1303                 (org-element-map tree 'table-cell 'identity)))))
1304     ;; 4. Otherwise, they will be aligned to the left.
1305     (org-test-with-parsed-data "
1306 | text      |
1307 | some text |
1308 | \alpha    |"
1309       (should
1310        (equal
1311         '(left left left)
1312         (mapcar (lambda (cell)
1313                   (org-export-table-cell-alignment cell info))
1314                 (org-element-map tree 'table-cell 'identity)))))))
1315
1316 (ert-deftest test-org-export/table-cell-borders ()
1317   "Test `org-export-table-cell-borders' specifications."
1318   ;; 1. Recognize various column groups indicators.
1319   (org-test-with-parsed-data "| / | < | > | <> |"
1320     (should
1321      (equal
1322       '((right bottom top) (left bottom top) (right bottom top)
1323         (right left bottom top))
1324       (mapcar (lambda (cell)
1325                 (org-export-table-cell-borders cell info))
1326               (org-element-map tree 'table-cell 'identity)))))
1327   ;; 2. Accept shortcuts to define column groups.
1328   (org-test-with-parsed-data "| / | < | < |"
1329     (should
1330      (equal
1331       '((right bottom top) (right left bottom top) (left bottom top))
1332       (mapcar (lambda (cell)
1333                 (org-export-table-cell-borders cell info))
1334               (org-element-map tree 'table-cell 'identity)))))
1335   ;; 3. A valid column groups row must start with a "/".
1336   (org-test-with-parsed-data "
1337 |   | < |
1338 | a | b |"
1339     (should
1340      (equal '((top) (top) (bottom) (bottom))
1341             (mapcar (lambda (cell)
1342                       (org-export-table-cell-borders cell info))
1343                     (org-element-map tree 'table-cell 'identity)))))
1344   ;; 4. Take table rules into consideration.
1345   (org-test-with-parsed-data "
1346 | 1 |
1347 |---|
1348 | 2 |"
1349     (should
1350      (equal '((below top) (bottom above))
1351             (mapcar (lambda (cell)
1352                       (org-export-table-cell-borders cell info))
1353                     (org-element-map tree 'table-cell 'identity)))))
1354   ;; 5. Top and (resp. bottom) rules induce both `top' and `above'
1355   ;;    (resp. `bottom' and `below') borders.  Any special row is
1356   ;;    ignored.
1357   (org-test-with-parsed-data "
1358 |---+----|
1359 | / |    |
1360 |   |  1 |
1361 |---+----|"
1362     (should
1363      (equal '((bottom below top above))
1364             (last
1365              (mapcar (lambda (cell)
1366                        (org-export-table-cell-borders cell info))
1367                      (org-element-map tree 'table-cell 'identity)))))))
1368
1369 (ert-deftest test-org-export/table-dimensions ()
1370   "Test `org-export-table-dimensions' specifications."
1371   ;; 1. Standard test.
1372   (org-test-with-parsed-data "
1373 | 1 | 2 | 3 |
1374 | 4 | 5 | 6 |"
1375     (should
1376      (equal '(2 . 3)
1377             (org-export-table-dimensions
1378              (org-element-map tree 'table 'identity info 'first-match) info))))
1379   ;; 2. Ignore horizontal rules and special columns.
1380   (org-test-with-parsed-data "
1381 | / | < | > |
1382 | 1 | 2 | 3 |
1383 |---+---+---|
1384 | 4 | 5 | 6 |"
1385     (should
1386      (equal '(2 . 3)
1387             (org-export-table-dimensions
1388              (org-element-map tree 'table 'identity info 'first-match) info)))))
1389
1390 (ert-deftest test-org-export/table-cell-address ()
1391   "Test `org-export-table-cell-address' specifications."
1392   ;; 1. Standard test: index is 0-based.
1393   (org-test-with-parsed-data "| a | b |"
1394     (should
1395      (equal '((0 . 0) (0 . 1))
1396             (org-element-map
1397              tree 'table-cell
1398              (lambda (cell) (org-export-table-cell-address cell info))
1399              info))))
1400   ;; 2. Special column isn't counted, nor are special rows.
1401   (org-test-with-parsed-data "
1402 | / | <> |
1403 |   | c  |"
1404     (should
1405      (equal '(0 . 0)
1406             (org-export-table-cell-address
1407              (car (last (org-element-map tree 'table-cell 'identity info)))
1408              info))))
1409   ;; 3. Tables rules do not count either.
1410   (org-test-with-parsed-data "
1411 | a |
1412 |---|
1413 | b |
1414 |---|
1415 | c |"
1416     (should
1417      (equal '(2 . 0)
1418             (org-export-table-cell-address
1419              (car (last (org-element-map tree 'table-cell 'identity info)))
1420              info))))
1421   ;; 4. Return nil for special cells.
1422   (org-test-with-parsed-data "| / | a |"
1423     (should-not
1424      (org-export-table-cell-address
1425       (org-element-map tree 'table-cell 'identity nil 'first-match)
1426       info))))
1427
1428 (ert-deftest test-org-export/get-table-cell-at ()
1429   "Test `org-export-get-table-cell-at' specifications."
1430   ;; 1. Address ignores special columns, special rows and rules.
1431   (org-test-with-parsed-data "
1432 | / | <> |
1433 |   | a  |
1434 |---+----|
1435 |   | b  |"
1436     (should
1437      (equal '("b")
1438             (org-element-contents
1439              (org-export-get-table-cell-at
1440               '(1 . 0)
1441               (org-element-map tree 'table 'identity info 'first-match)
1442               info)))))
1443   ;; 2. Return value for a non-existent address is nil.
1444   (org-test-with-parsed-data "| a |"
1445     (should-not
1446      (org-export-get-table-cell-at
1447       '(2 . 2)
1448       (org-element-map tree 'table 'identity info 'first-match)
1449       info)))
1450   (org-test-with-parsed-data "| / |"
1451     (should-not
1452      (org-export-get-table-cell-at
1453       '(0 . 0)
1454       (org-element-map tree 'table 'identity info 'first-match)
1455       info))))
1456
1457 (ert-deftest test-org-export/table-cell-starts-colgroup-p ()
1458   "Test `org-export-table-cell-starts-colgroup-p' specifications."
1459   ;; 1. A cell at a beginning of a row always starts a column group.
1460   (org-test-with-parsed-data "| a |"
1461     (should
1462      (org-export-table-cell-starts-colgroup-p
1463       (org-element-map tree 'table-cell 'identity info 'first-match)
1464       info)))
1465   ;; 2. Special column should be ignored when determining the
1466   ;;    beginning of the row.
1467   (org-test-with-parsed-data "
1468 | / |   |
1469 |   | a |"
1470     (should
1471      (org-export-table-cell-starts-colgroup-p
1472       (org-element-map tree 'table-cell 'identity info 'first-match)
1473       info)))
1474   ;; 2. Explicit column groups.
1475   (org-test-with-parsed-data "
1476 | / |   | < |
1477 | a | b | c |"
1478     (should
1479      (equal
1480       '(yes no yes)
1481       (org-element-map
1482        tree 'table-cell
1483        (lambda (cell)
1484          (if (org-export-table-cell-starts-colgroup-p cell info) 'yes 'no))
1485        info)))))
1486
1487 (ert-deftest test-org-export/table-cell-ends-colgroup-p ()
1488   "Test `org-export-table-cell-ends-colgroup-p' specifications."
1489   ;; 1. A cell at the end of a row always ends a column group.
1490   (org-test-with-parsed-data "| a |"
1491     (should
1492      (org-export-table-cell-ends-colgroup-p
1493       (org-element-map tree 'table-cell 'identity info 'first-match)
1494       info)))
1495   ;; 2. Special column should be ignored when determining the
1496   ;;    beginning of the row.
1497   (org-test-with-parsed-data "
1498 | / |   |
1499 |   | a |"
1500     (should
1501      (org-export-table-cell-ends-colgroup-p
1502       (org-element-map tree 'table-cell 'identity info 'first-match)
1503       info)))
1504   ;; 3. Explicit column groups.
1505   (org-test-with-parsed-data "
1506 | / | < |   |
1507 | a | b | c |"
1508     (should
1509      (equal
1510       '(yes no yes)
1511       (org-element-map
1512        tree 'table-cell
1513        (lambda (cell)
1514          (if (org-export-table-cell-ends-colgroup-p cell info) 'yes 'no))
1515        info)))))
1516
1517 (ert-deftest test-org-export/table-row-starts-rowgroup-p ()
1518   "Test `org-export-table-row-starts-rowgroup-p' specifications."
1519   ;; 1. A row at the beginning of a table always starts a row group.
1520   ;;    So does a row following a table rule.
1521   (org-test-with-parsed-data "
1522 | a |
1523 |---|
1524 | b |"
1525     (should
1526      (equal
1527       '(yes no yes)
1528       (org-element-map
1529        tree 'table-row
1530        (lambda (row)
1531          (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
1532        info))))
1533   ;; 2. Special rows should be ignored when determining the beginning
1534   ;;    of the row.
1535   (org-test-with-parsed-data "
1536 | / | < |
1537 |   | a |
1538 |---+---|
1539 | / | < |
1540 |   | b |"
1541     (should
1542      (equal
1543       '(yes no yes)
1544       (org-element-map
1545        tree 'table-row
1546        (lambda (row)
1547          (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
1548        info)))))
1549
1550 (ert-deftest test-org-export/table-row-ends-rowgroup-p ()
1551   "Test `org-export-table-row-ends-rowgroup-p' specifications."
1552   ;; 1. A row at the end of a table always ends a row group.  So does
1553   ;;    a row preceding a table rule.
1554   (org-test-with-parsed-data "
1555 | a |
1556 |---|
1557 | b |"
1558     (should
1559      (equal
1560       '(yes no yes)
1561       (org-element-map
1562        tree 'table-row
1563        (lambda (row)
1564          (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
1565        info))))
1566   ;; 2. Special rows should be ignored when determining the beginning
1567   ;;    of the row.
1568   (org-test-with-parsed-data "
1569 |   | a |
1570 | / | < |
1571 |---+---|
1572 |   | b |
1573 | / | < |"
1574     (should
1575      (equal
1576       '(yes no yes)
1577       (org-element-map
1578        tree 'table-row
1579        (lambda (row)
1580          (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
1581        info)))))
1582
1583 (ert-deftest test-org-export/table-row-starts-header-p ()
1584   "Test `org-export-table-row-starts-header-p' specifications."
1585   ;; 1. Only the row starting the first row group starts the table
1586   ;;    header.
1587   (org-test-with-parsed-data "
1588 | a |
1589 | b |
1590 |---|
1591 | c |"
1592     (should
1593      (equal
1594       '(yes no no no)
1595       (org-element-map
1596        tree 'table-row
1597        (lambda (row)
1598          (if (org-export-table-row-starts-header-p row info) 'yes 'no))
1599        info))))
1600   ;; 2. A row cannot start an header if there's no header in the
1601   ;;    table.
1602   (org-test-with-parsed-data "
1603 | a |
1604 |---|"
1605     (should-not
1606      (org-export-table-row-starts-header-p
1607       (org-element-map tree 'table-row 'identity info 'first-match)
1608       info))))
1609
1610 (ert-deftest test-org-export/table-row-ends-header-p ()
1611   "Test `org-export-table-row-ends-header-p' specifications."
1612   ;; 1. Only the row starting the first row group starts the table
1613   ;;    header.
1614   (org-test-with-parsed-data "
1615 | a |
1616 | b |
1617 |---|
1618 | c |"
1619     (should
1620      (equal
1621       '(no yes no no)
1622       (org-element-map
1623        tree 'table-row
1624        (lambda (row)
1625          (if (org-export-table-row-ends-header-p row info) 'yes 'no))
1626        info))))
1627   ;; 2. A row cannot start an header if there's no header in the
1628   ;;    table.
1629   (org-test-with-parsed-data "
1630 | a |
1631 |---|"
1632     (should-not
1633      (org-export-table-row-ends-header-p
1634       (org-element-map tree 'table-row 'identity info 'first-match)
1635       info))))
1636
1637
1638 \f
1639 ;;; Topology
1640
1641 (ert-deftest test-org-export/get-next-element ()
1642   "Test `org-export-get-next-element' specifications."
1643   ;; Standard test.
1644   (should
1645    (equal "b"
1646           (org-test-with-parsed-data "* Headline\n*a* b"
1647             (org-export-get-next-element
1648              (org-element-map tree 'bold 'identity info t) info))))
1649   ;; Return nil when no previous element.
1650   (should-not
1651    (org-test-with-parsed-data "* Headline\na *b*"
1652      (org-export-get-next-element
1653       (org-element-map tree 'bold 'identity info t) info)))
1654   ;; Non-exportable elements are ignored.
1655   (should-not
1656    (let ((org-export-with-timestamps nil))
1657      (org-test-with-parsed-data "\alpha <2012-03-29 Thu>"
1658        (org-export-get-next-element
1659         (org-element-map tree 'entity 'identity info t) info)))))
1660
1661 (ert-deftest test-org-export/get-previous-element ()
1662   "Test `org-export-get-previous-element' specifications."
1663   ;; Standard test.
1664   (should
1665    (equal "a "
1666           (org-test-with-parsed-data "* Headline\na *b*"
1667             (org-export-get-previous-element
1668              (org-element-map tree 'bold 'identity info t) info))))
1669   ;; Return nil when no previous element.
1670   (should-not
1671    (org-test-with-parsed-data "* Headline\n*a* b"
1672      (org-export-get-previous-element
1673       (org-element-map tree 'bold 'identity info t) info)))
1674   ;; Non-exportable elements are ignored.
1675   (should-not
1676    (let ((org-export-with-timestamps nil))
1677      (org-test-with-parsed-data "<2012-03-29 Thu> \alpha"
1678        (org-export-get-previous-element
1679         (org-element-map tree 'entity 'identity info t) info)))))
1680
1681
1682 (provide 'test-org-export)
1683 ;;; test-org-export.el end here