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/export-call-line-information ()
 201   (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
 202     (org-narrow-to-subtree)
 203     (let ((org-babel-exp-call-line-template "\n: call: %line special-token"))
 204       (org-test-with-expanded-babel-code
 205        (should (string-match "double" (buffer-string)))
 206        (should (string-match "16" (buffer-string)))
 207        (should (string-match "special-token" (buffer-string)))))))
 208
 209 (ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
 210   (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
 211     (org-narrow-to-subtree)
 212     (org-babel-next-src-block 2)
 213     (should (= 110 (org-babel-execute-src-block)))
 214     (let ((result (org-test-with-expanded-babel-code (buffer-string))))
 215       (should-not (string-match (regexp-quote "<<strip-export-1>>") result))
 216       (should-not (string-match (regexp-quote "i=\"10\"") result)))))
 217
 218 (ert-deftest ob-exp/use-case-of-reading-entry-properties ()
 219   (org-test-at-id "cc5fbc20-bca5-437a-a7b8-2b4d7a03f820"
 220     (org-narrow-to-subtree)
 221     (let* ((case-fold-search nil)
 222            (result (org-test-with-expanded-babel-code (buffer-string)))
 223            (sect "a:1, b:0, c:3, d:0, e:0")
 224            (sub0 "a:1, b:2, c:4, d:0, e:0")
 225            (sub1 "a:1, b:2, c:5, d:0, e:6")
 226            (func sub0))
 227       ;; entry "section"
 228       (should (string-match (concat "_shell sect call\n: shell " sect "\n")
 229                             result))
 230       (should (string-match (concat "_elisp sect call\n: elisp " sect "\n")
 231                             result))
 232       (should (string-match (concat "\n- sect inline =shell " sect "=\n")
 233                             result))
 234       (should (string-match (concat "\n- sect inline =elisp " sect "=\n")
 235                             result))
 236       ;; entry "subsection", call without arguments
 237       (should (string-match (concat "_shell sub0 call\n: shell " sub0 "\n")
 238                             result))
 239       (should (string-match (concat "_elisp sub0 call\n: elisp " sub0 "\n")
 240                             result))
 241       (should (string-match (concat "\n- sub0 inline =shell " sub0 "=\n")
 242                             result))
 243       (should (string-match (concat "\n- sub0 inline =elisp " sub0 "=\n")
 244                             result))
 245       ;; entry "subsection", call with arguments
 246       (should (string-match (concat "_shell sub1 call\n: shell " sub1 "\n")
 247                             result))
 248       (should (string-match (concat "_elisp sub1 call\n: elisp " sub1 "\n")
 249                             result))
 250       (should (string-match (concat "\n- sub1 inline =shell " sub1 "=\n")
 251                             result))
 252       (should (string-match (concat "\n- sub1 inline =elisp " sub1 "=\n")
 253                             result))
 254       ;; entry "function definition"
 255       (should (string-match (concat "_location_shell\n: shell " func "\n")
 256                             result))
 257       (should (string-match (concat "_location_elisp\n: elisp " func "\n")
 258                             result)))))
 259
 260 (ert-deftest ob-exp/export-from-a-temp-buffer ()
 261   :expected-result :failed
 262   (org-test-with-temp-text
 263       "
 264 #+Title: exporting from a temporary buffer
 265
 266 #+name: foo
 267 #+BEGIN_SRC emacs-lisp
 268   :foo
 269 #+END_SRC
 270
 271 #+name: bar
 272 #+BEGIN_SRC emacs-lisp
 273   :bar
 274 #+END_SRC
 275
 276 #+BEGIN_SRC emacs-lisp :var foo=foo :noweb yes :exports results
 277   (list foo <<bar>>)
 278 #+END_SRC
 279 "
 280     (let* ((ascii (org-export-as 'ascii)))
 281       (should (string-match (regexp-quote (format nil "%S" '(:foo :bar)))
 282                             ascii)))))
 283
 284 (ert-deftest ob-export/export-with-results-before-block ()
 285   "Test export when results are inserted before source block."
 286   (should
 287    (equal
 288     "#+RESULTS: src1
 289 : 2
 290
 291 #+NAME: src1
 292 #+BEGIN_SRC emacs-lisp
 293 \(+ 1 1)
 294 #+END_SRC"
 295     (org-test-with-temp-text
 296         "#+RESULTS: src1
 297
 298 #+NAME: src1
 299 #+BEGIN_SRC emacs-lisp :exports both
 300 \(+ 1 1)
 301 #+END_SRC"
 302       (org-export-execute-babel-code)
 303       (buffer-string)))))
 304
 305 (ert-deftest ob-export/export-src-block-with-switches ()
 306   "Test exporting a source block with switches."
 307   (should
 308    (string-match
 309     "\\`#\\+BEGIN_SRC emacs-lisp -n -r$"
 310     (org-test-with-temp-text
 311         "#+BEGIN_SRC emacs-lisp -n -r\n\(+ 1 1)\n#+END_SRC"
 312       (org-export-execute-babel-code)
 313       (buffer-string)))))
 314
 315 (ert-deftest ob-export/export-src-block-with-flags ()
 316   "Test exporting a source block with a flag."
 317   (should
 318    (string-match
 319     "\\`#\\+BEGIN_SRC emacs-lisp -some-flag$"
 320     (org-test-with-temp-text
 321         "#+BEGIN_SRC emacs-lisp :flags -some-flag\n\(+ 1 1)\n#+END_SRC"
 322       (org-export-execute-babel-code)
 323       (buffer-string)))))
 324
 325 (ert-deftest ob-export/export-and-indentation ()
 326   "Test indentation of evaluated source blocks during export."
 327   ;; No indentation.
 328   (should
 329    (string-match
 330     "^t"
 331     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 332       (let ((indent-tabs-mode t)
 333             (tab-width 1)
 334             (org-src-preserve-indentation nil))
 335         (org-export-execute-babel-code)
 336         (buffer-string)))))
 337   ;; Preserve indentation with "-i" flag.
 338   (should
 339    (string-match
 340     "^ t"
 341     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n t\n#+END_SRC"
 342       (let ((indent-tabs-mode t)
 343             (tab-width 1))
 344         (org-export-execute-babel-code)
 345         (buffer-string)))))
 346   ;; Preserve indentation with a non-nil
 347   ;; `org-src-preserve-indentation'.
 348   (should
 349    (string-match
 350     "^ t"
 351     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 352       (let ((indent-tabs-mode t)
 353             (tab-width 1)
 354             (org-src-preserve-indentation t))
 355         (org-export-execute-babel-code)
 356         (buffer-string))))))
 357
 358 (ert-deftest ob-export/export-under-commented-headline ()
 359   "Test evaluation of code blocks under COMMENT headings."
 360   ;; Do not eval block in a commented headline.
 361   (should
 362    (string-match
 363     ": 2"
 364     (org-test-with-temp-text "* Headline
 365 #+BEGIN_SRC emacs-lisp :exports results
 366 \(+ 1 1)
 367 #+END_SRC"
 368       (org-export-execute-babel-code)
 369       (buffer-string))))
 370   (should-not
 371    (string-match
 372     ": 2"
 373     (org-test-with-temp-text "* COMMENT Headline
 374 #+BEGIN_SRC emacs-lisp :exports results
 375 \(+ 1 1)
 376 #+END_SRC"
 377       (org-export-execute-babel-code)
 378       (buffer-string))))
 379   ;; Do not eval inline blocks either.
 380   (should
 381    (string-match
 382     "=2="
 383     (org-test-with-temp-text "* Headline
 384 src_emacs-lisp{(+ 1 1)}"
 385       (org-export-execute-babel-code)
 386       (buffer-string))))
 387   (should-not
 388    (string-match
 389     "=2="
 390     (org-test-with-temp-text "* COMMENT Headline
 391 src_emacs-lisp{(+ 1 1)}"
 392       (org-export-execute-babel-code)
 393       (buffer-string))))
 394   ;; Also check parent headlines.
 395   (should-not
 396    (string-match
 397     ": 2"
 398     (org-test-with-temp-text "
 399 * COMMENT Headline
 400 ** Children
 401 #+BEGIN_SRC emacs-lisp :exports results
 402 \(+ 1 1)
 403 #+END_SRC"
 404       (org-export-execute-babel-code)
 405       (buffer-string)))))
 406
 407 (ert-deftest ob-export/reference-in-post-header ()
 408   "Test references in :post header during export."
 409   (should
 410    (org-test-with-temp-text "
 411 #+NAME: foo
 412 #+BEGIN_SRC emacs-lisp :exports none :var bar=\"baz\"
 413   (concat \"bar\" bar)
 414 #+END_SRC
 415
 416 #+NAME: nofun
 417 #+BEGIN_SRC emacs-lisp :exports results :post foo(\"nofun\")
 418 #+END_SRC"
 419      (org-export-execute-babel-code) t)))
 420
 421
 422 (provide 'test-ob-exp)
 423
 424 ;;; test-ob-exp.el ends here