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