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