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