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