testing/lisp/test-ob-exp.el

   1 ;;; test-ob-exp.el
   2
   3 ;; Copyright (c) 2010-2014 Eric Schulte
   4 ;; Authors: Eric Schulte
   5
   6 ;; This file is not part of GNU Emacs.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Comments:
  22
  23 ;; Template test file for Org-mode tests
  24
  25 ;;; Code:
  26
  27 (defmacro org-test-with-expanded-babel-code (&rest body)
  28   "Execute BODY while in a buffer with all Babel code evaluated.
  29 Current buffer is a copy of the original buffer."
  30   `(let ((string (buffer-string))
  31          (buf (current-buffer))
  32          (org-export-babel-evaluate t))
  33      (with-temp-buffer
  34        (org-mode)
  35        (insert string)
  36        (org-babel-exp-process-buffer buf)
  37        (goto-char (point-min))
  38        (progn ,@body))))
  39
  40 (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers ()
  41   "Testing export without any headlines in the Org mode file."
  42   (require 'ox-html)
  43   (let ((html-file (concat (file-name-sans-extension org-test-no-heading-file)
  44                            ".html")))
  45     (when (file-exists-p html-file) (delete-file html-file))
  46     (org-test-in-example-file org-test-no-heading-file
  47       ;; Export the file to HTML.
  48       (org-export-to-file 'html html-file))
  49     ;; should create a .html file
  50     (should (file-exists-p html-file))
  51     ;; should not create a file with "::" appended to it's name
  52     (should-not (file-exists-p (concat org-test-no-heading-file "::")))
  53     (when (file-exists-p html-file) (delete-file html-file))))
  54
  55 (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-file ()
  56   "Testing export from buffers which are not visiting any file."
  57   (require 'ox-html)
  58   (let ((name (generate-new-buffer-name "*Org HTML Export*")))
  59     (org-test-in-example-file nil
  60       (org-export-to-buffer 'html name nil nil nil t))
  61     ;; Should create a HTML buffer.
  62     (should (buffer-live-p (get-buffer name)))
  63     ;; Should contain the content of the buffer.
  64     (with-current-buffer (get-buffer name)
  65       (should (string-match (regexp-quote org-test-file-ob-anchor)
  66                             (buffer-string))))
  67     (when (get-buffer name) (kill-buffer name))))
  68
  69 (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers2 ()
  70   "Testing export without any headlines in the org-mode file."
  71   (let ((html-file (concat (file-name-sans-extension
  72                             org-test-link-in-heading-file)
  73                            ".html")))
  74     (when (file-exists-p html-file) (delete-file html-file))
  75     (org-test-in-example-file org-test-link-in-heading-file
  76       ;; export the file to html
  77       (org-export-to-file 'html html-file))
  78     ;; should create a .html file
  79     (should (file-exists-p html-file))
  80     ;; should not create a file with "::" appended to it's name
  81     (should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
  82     (when (file-exists-p html-file) (delete-file html-file))))
  83
  84 (ert-deftest ob-exp/noweb-on-export ()
  85   "Noweb header arguments export correctly.
  86 - yes      expand on both export and tangle
  87 - no       expand on neither export or tangle
  88 - tangle   expand on only tangle not export"
  89   (should
  90    (equal
  91     '("(message \"expanded1\")" "(message \"expanded2\")" ";; noweb-1-yes-start
  92   (message \"expanded1\")
  93   (message \"expanded1\")" ";; noweb-no-start
  94   <<noweb-example1>>" ";; noweb-2-yes-start
  95   (message \"expanded2\")
  96   (message \"expanded2\")"
  97   ";; noweb-tangle-start
  98 <<noweb-example1>>
  99 <<noweb-example2>>")
 100     (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
 101       (org-narrow-to-subtree)
 102       (org-element-map
 103           (org-test-with-expanded-babel-code (org-element-parse-buffer))
 104           'src-block
 105         (lambda (src) (org-trim (org-element-property :value src))))))))
 106
 107 (ert-deftest ob-exp/noweb-on-export-with-exports-results ()
 108   "Noweb header arguments export correctly using :exports results.
 109 - yes      expand on both export and tangle
 110 - no       expand on neither export or tangle
 111 - tangle   expand on only tangle not export"
 112   (should
 113    (equal
 114     '(";; noweb-no-start
 115   <<noweb-example1>>" "<<noweb-example1>>
 116 <<noweb-example2>>")
 117     (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d"
 118       (org-narrow-to-subtree)
 119       (org-element-map
 120           (org-test-with-expanded-babel-code (org-element-parse-buffer))
 121           'src-block
 122         (lambda (src) (org-trim (org-element-property :value src))))))))
 123
 124 (ert-deftest ob-exp/exports-both ()
 125   "Test the \":exports both\" header argument.
 126 The code block evaluation should create both a code block and
 127 a table."
 128   (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
 129     (org-narrow-to-subtree)
 130     (let ((tree (org-test-with-expanded-babel-code (org-element-parse-buffer))))
 131       (should (and (org-element-map tree 'src-block 'identity)
 132                    (org-element-map tree 'table 'identity))))))
 133
 134 (ert-deftest ob-exp/mixed-blocks-with-exports-both ()
 135   (should
 136    (equal
 137     '(property-drawer plain-list src-block fixed-width src-block plain-list)
 138     (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
 139       (org-narrow-to-subtree)
 140       (mapcar 'org-element-type
 141               (org-element-map
 142                   (org-test-with-expanded-babel-code
 143                    (org-element-parse-buffer 'greater-element))
 144                   'section 'org-element-contents nil t))))))
 145
 146 (ert-deftest ob-exp/export-with-name ()
 147   (should
 148    (string-match
 149     "=qux="
 150     (let ((org-babel-exp-code-template
 151            "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
 152       (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
 153         (org-narrow-to-subtree)
 154         (org-test-with-expanded-babel-code
 155          (buffer-string)))))))
 156
 157 (ert-deftest ob-exp/export-with-header-argument ()
 158   (let ((org-babel-exp-code-template
 159          "
 160 | header  | value    |
 161 |---------+----------|
 162 | foo     | %foo     |
 163 | results | %results |
 164 #+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
 165     (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
 166       (org-narrow-to-subtree)
 167       (org-test-with-expanded-babel-code
 168        (should (string-match "baz" (buffer-string)))
 169        (should (string-match "replace" (buffer-string)))))))
 170
 171 (ert-deftest ob-exp/noweb-no-export-and-exports-both ()
 172   (should
 173    (string-match
 174     "<<noweb-no-export-and-exports-both-1>>"
 175     (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
 176       (org-narrow-to-subtree)
 177       (org-test-with-expanded-babel-code
 178        (org-element-map (org-element-parse-buffer) 'src-block
 179          (lambda (src-block) (org-element-property :value src-block))
 180          nil t))))))
 181
 182 (ert-deftest ob-exp/evaluate-all-executables-in-order ()
 183   (should
 184    (equal '(5 4 3 2 1)
 185           (let ((org-export-babel-evaluate t) *evaluation-collector*)
 186             (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
 187               (org-narrow-to-subtree)
 188               (buffer-string)
 189               (org-test-with-expanded-babel-code *evaluation-collector*))))))
 190
 191 (ert-deftest ob-exp/exports-inline ()
 192   (should
 193    (string-match
 194     (regexp-quote "Here is one in the middle {{{results(=1=)}}} of a line.
 195 Here is one at the end of a line. {{{results(=2=)}}}
 196 {{{results(=3=)}}} Here is one at the beginning of a line.")
 197     (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
 198       (org-narrow-to-subtree)
 199       (let ((org-babel-inline-result-wrap "=%s="))
 200         (org-test-with-expanded-babel-code (buffer-string)))))))
 201
 202 (ert-deftest ob-exp/exports-inline-code ()
 203   (let ((org-babel-inline-result-wrap "=%s=")
 204         (org-export-babel-evaluate t))
 205     (should
 206      (string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)}$"
 207                    (org-test-with-temp-text
 208                        "src_emacs-lisp[:exports code]{(+ 1 1)}"
 209                      (org-export-execute-babel-code)
 210                      (buffer-string))))
 211     (should
 212      (string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)}$"
 213                    (org-test-with-temp-text
 214                        "src_emacs-lisp[ :exports code ]{(+ 1 1)}"
 215                      (org-export-execute-babel-code)
 216                      (buffer-string))))
 217     (should
 218      (string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)} {{{results(=2=)}}}$"
 219                    (org-test-with-temp-text
 220                        "src_emacs-lisp[:exports both]{(+ 1 1)}"
 221                      (org-export-execute-babel-code)
 222                      (buffer-string))))
 223     (should
 224      (string-match "\\`{{{results(=2=)}}}$"
 225                    (org-test-with-temp-text
 226                        "src_emacs-lisp[:exports results :results scalar]{(+ 1 1)}"
 227                      (org-export-execute-babel-code)
 228                      (buffer-string))))
 229     (should
 230      (let ((text "foosrc_emacs-lisp[:exports code]{(+ 1 1)}"))
 231        (string-match (regexp-quote text)
 232                      (org-test-with-temp-text
 233                          text
 234                        (org-export-execute-babel-code)
 235                        (buffer-string)))))
 236     (should
 237      (let ((text "src_emacs lisp{(+ 1 1)}"))
 238        (string-match (regexp-quote text)
 239                      (org-test-with-temp-text
 240                          text
 241                        (org-export-execute-babel-code)
 242                        (buffer-string)))))
 243     (should
 244      (string-match
 245       (replace-regexp-in-string
 246        "\\\\\\[]{" "\\(?:\\[]\\)?{" ;accept both src_sh[]{...} or src_sh{...}
 247        (regexp-quote "Here is one in the middle src_sh[]{echo 1} of a line.
 248 Here is one at the end of a line. src_sh[]{echo 2}
 249 src_sh[]{echo 3} Here is one at the beginning of a line.
 250 Here is one that is also evaluated: src_sh[]{echo 4} {{{results(=4=)}}}")
 251        nil t)
 252       (org-test-at-id "cd54fc88-1b6b-45b6-8511-4d8fa7fc8076"
 253         (org-narrow-to-subtree)
 254         (org-test-with-expanded-babel-code (buffer-string)))))))
 255
 256 (ert-deftest ob-exp/exports-inline-code-double-eval ()
 257   "Based on default header arguments for inline code blocks (:exports
 258 results), the resulting code block `src_emacs-lisp{2}' should also be
 259 evaluated."
 260   (let ((org-babel-inline-result-wrap "=%s=")
 261         (org-export-babel-evaluate t))
 262     (should
 263      (string-match "\\`{{{results(src_emacs-lisp\\[\\]{2})}}}$"
 264                    (org-test-with-temp-text
 265                        "src_emacs-lisp[:exports results :results code]{(+ 1 1)}"
 266                      (org-export-execute-babel-code)
 267                      (buffer-string))))))
 268
 269 (ert-deftest ob-exp/exports-inline-code-eval-code-once ()
 270   "Ibid above, except that the resulting inline code block should not
 271 be evaluated."
 272   (let ((org-export-babel-evaluate t))
 273     (should
 274      (string-match "{{{results(src_emacs-lisp\\(?:\\[[: a-zA-Z]+]\\)?{2})}}}$"
 275                    (org-test-with-temp-text
 276                        (concat "src_emacs-lisp[:exports results :results code "
 277                                ":results_switches \":exports code\"]{(+ 1 1)}")
 278                      (org-export-execute-babel-code)
 279                      (buffer-string))))))
 280
 281 (ert-deftest ob-exp/exports-inline-code-double-eval-exports-both ()
 282   (let ((org-export-babel-evaluate t))
 283     (should
 284      (string-match (concat "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)} "
 285                            "{{{results(src_emacs-lisp\\[ :exports code\\]{2})}}}$")
 286                    (org-test-with-temp-text
 287                        (concat "src_emacs-lisp[:exports both :results code "
 288                                ":results_switches \":exports code\"]{(+ 1 1)}")
 289                      (org-export-execute-babel-code)
 290                      (buffer-string))))))
 291
 292 (ert-deftest ob-exp/export-call-line-information ()
 293   (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
 294     (org-narrow-to-subtree)
 295     (let ((org-babel-exp-call-line-template "\n: call: %line special-token"))
 296       (org-test-with-expanded-babel-code
 297        (should (string-match "double" (buffer-string)))
 298        (should (string-match "16" (buffer-string)))
 299        (should (string-match "special-token" (buffer-string)))))))
 300
 301 (ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
 302   (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
 303     (org-narrow-to-subtree)
 304     (org-babel-next-src-block 2)
 305     (should (= 110 (org-babel-execute-src-block)))
 306     (let ((result (org-test-with-expanded-babel-code (buffer-string))))
 307       (should-not (string-match (regexp-quote "<<strip-export-1>>") result))
 308       (should-not (string-match (regexp-quote "i=\"10\"") result)))))
 309
 310 (ert-deftest ob-exp/use-case-of-reading-entry-properties ()
 311   (org-test-at-id "cc5fbc20-bca5-437a-a7b8-2b4d7a03f820"
 312     (org-narrow-to-subtree)
 313     (let* ((case-fold-search nil)
 314            (result (org-test-with-expanded-babel-code (buffer-string)))
 315            (sect "a:1, b:0, c:3, d:0, e:0")
 316            (sub0 "a:1, b:2, c:4, d:0, e:0")
 317            (sub1 "a:1, b:2, c:5, d:0, e:6")
 318            (func sub0))
 319       ;; entry "section"
 320       (should (string-match (concat "_shell-sect-call\n: shell " sect "\n")
 321                             result))
 322       (should (string-match (concat "_elisp-sect-call\n: elisp " sect "\n")
 323                             result))
 324       (should (string-match (concat "\n- sect inline shell " sect "\n")
 325                             result))
 326       (should (string-match (concat "\n- sect inline elisp " sect "\n")
 327                             result))
 328             ;; entry "subsection", call without arguments
 329       (should (string-match (concat "_shell-sub0-call\n: shell " sub0 "\n")
 330                             result))
 331       (should (string-match (concat "_elisp-sub0-call\n: elisp " sub0 "\n")
 332                             result))
 333       (should (string-match (concat "\n- sub0 inline shell " sub0 "\n")
 334                             result))
 335       (should (string-match (concat "\n- sub0 inline elisp " sub0 "\n")
 336                             result))
 337       ;; entry "subsection", call with arguments
 338       (should (string-match (concat "_shell-sub1-call\n: shell " sub1 "\n")
 339                             result))
 340       (should (string-match (concat "_elisp-sub1-call\n: elisp " sub1 "\n")
 341                             result))
 342       (should (string-match (concat "\n- sub1 inline shell " sub1 "\n")
 343                             result))
 344       (should (string-match (concat "\n- sub1 inline elisp " sub1 "\n")
 345                             result))
 346       ;; entry "function definition"
 347       (should (string-match (concat "_location_shell\n: shell " func "\n")
 348                             result))
 349       (should (string-match (concat "_location_elisp\n: elisp " func "\n")
 350                             result)))))
 351
 352 (ert-deftest ob-exp/export-from-a-temp-buffer ()
 353   (let ((org-export-babel-evaluate t))
 354     (org-test-with-temp-text
 355         "
 356 #+Title: exporting from a temporary buffer
 357
 358 #+name: foo
 359 #+BEGIN_SRC emacs-lisp
 360   :foo
 361 #+END_SRC
 362
 363 #+name: bar
 364 #+BEGIN_SRC emacs-lisp
 365   :bar
 366 #+END_SRC
 367
 368 #+BEGIN_SRC emacs-lisp :var foo=foo :noweb yes :exports results
 369   (list foo <<bar>>)
 370 #+END_SRC
 371 "
 372       (let* ((ascii (org-export-as 'ascii)))
 373         (should (string-match
 374                  (regexp-quote " :foo  :bar \n")
 375                  ascii))))))
 376
 377 (ert-deftest ob-export/export-with-results-before-block ()
 378   "Test export when results are inserted before source block."
 379   (let ((org-export-babel-evaluate t))
 380     (should
 381      (equal
 382       "#+RESULTS: src1
 383 : 2
 384
 385 #+NAME: src1
 386 #+BEGIN_SRC emacs-lisp
 387 \(+ 1 1)
 388 #+END_SRC"
 389       (org-test-with-temp-text
 390           "#+RESULTS: src1
 391
 392 #+NAME: src1
 393 #+BEGIN_SRC emacs-lisp :exports both
 394 \(+ 1 1)
 395 #+END_SRC"
 396         (org-export-execute-babel-code)
 397         (org-trim (org-no-properties (buffer-string))))))))
 398
 399 (ert-deftest ob-export/export-src-block-with-switches ()
 400   "Test exporting a source block with switches."
 401   (should
 402    (string-match
 403     "\\`#\\+BEGIN_SRC emacs-lisp -n -r$"
 404     (org-test-with-temp-text
 405         "#+BEGIN_SRC emacs-lisp -n -r\n\(+ 1 1)\n#+END_SRC"
 406       (org-export-execute-babel-code)
 407       (buffer-string)))))
 408
 409 (ert-deftest ob-export/export-src-block-with-flags ()
 410   "Test exporting a source block with a flag."
 411   (should
 412    (string-match
 413     "\\`#\\+BEGIN_SRC emacs-lisp -some-flag$"
 414     (org-test-with-temp-text
 415         "#+BEGIN_SRC emacs-lisp :flags -some-flag\n\(+ 1 1)\n#+END_SRC"
 416       (org-export-execute-babel-code)
 417       (buffer-string)))))
 418
 419 (ert-deftest ob-export/export-and-indentation ()
 420   "Test indentation of evaluated source blocks during export."
 421   ;; No indentation.
 422   (should
 423    (string-match
 424     "^t"
 425     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 426       (let ((indent-tabs-mode t)
 427             (tab-width 1)
 428             (org-src-preserve-indentation nil))
 429         (org-export-execute-babel-code)
 430         (buffer-string)))))
 431   ;; Preserve indentation with "-i" flag.
 432   (should
 433    (string-match
 434     "^ t"
 435     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n t\n#+END_SRC"
 436       (let ((indent-tabs-mode t)
 437             (tab-width 1))
 438         (org-export-execute-babel-code)
 439         (buffer-string)))))
 440   ;; Preserve indentation with a non-nil
 441   ;; `org-src-preserve-indentation'.
 442   (should
 443    (string-match
 444     "^ t"
 445     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 446       (let ((indent-tabs-mode t)
 447             (tab-width 1)
 448             (org-src-preserve-indentation t))
 449         (org-export-execute-babel-code)
 450         (buffer-string))))))
 451
 452 (ert-deftest ob-export/export-under-commented-headline ()
 453   "Test evaluation of code blocks under COMMENT headings."
 454   (let ((org-export-babel-evaluate t)
 455         (org-babel-inline-result-wrap "=%s="))
 456     ;; Do not eval block in a commented headline.
 457     (should
 458      (string-match
 459       ": 2"
 460       (org-test-with-temp-text "* Headline
 461 #+BEGIN_SRC emacs-lisp :exports results
 462 \(+ 1 1)
 463 #+END_SRC"
 464         (org-export-execute-babel-code)
 465         (buffer-string))))
 466     (should-not
 467      (string-match
 468       ": 2"
 469       (org-test-with-temp-text "* COMMENT Headline
 470 #+BEGIN_SRC emacs-lisp :exports results
 471 \(+ 1 1)
 472 #+END_SRC"
 473         (org-export-execute-babel-code)
 474         (buffer-string))))
 475     ;; Do not eval inline blocks either.
 476     (should
 477      (string-match
 478       "=2="
 479       (org-test-with-temp-text "* Headline
 480 src_emacs-lisp{(+ 1 1)}"
 481         (org-export-execute-babel-code)
 482         (buffer-string))))
 483     (should-not
 484      (string-match
 485       "=2="
 486       (org-test-with-temp-text "* COMMENT Headline
 487 src_emacs-lisp{(+ 1 1)}"
 488         (org-export-execute-babel-code)
 489         (buffer-string))))
 490     ;; Also check parent headlines.
 491     (should-not
 492      (string-match
 493       ": 2"
 494       (org-test-with-temp-text "
 495 * COMMENT Headline
 496 ** Children
 497 #+BEGIN_SRC emacs-lisp :exports results
 498 \(+ 1 1)
 499 #+END_SRC"
 500         (org-export-execute-babel-code)
 501         (buffer-string))))))
 502
 503 (ert-deftest ob-export/reference-in-post-header ()
 504   "Test references in :post header during export."
 505   (should
 506    (org-test-with-temp-text "
 507 #+NAME: foo
 508 #+BEGIN_SRC emacs-lisp :exports none :var bar=\"baz\"
 509   (concat \"bar\" bar)
 510 #+END_SRC
 511
 512 #+NAME: nofun
 513 #+BEGIN_SRC emacs-lisp :exports results :post foo(\"nofun\")
 514 #+END_SRC"
 515      (org-export-execute-babel-code) t)))
 516
 517
 518 (provide 'test-ob-exp)
 519
 520 ;;; test-ob-exp.el ends here