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        (let ((org-current-export-file buf))
  36          (org-babel-exp-process-buffer))
  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\")" ";; noweb-tangle-start
  97 <<noweb-example1>>
  98 <<noweb-example2>>")
  99     (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
 100       (org-narrow-to-subtree)
 101       (org-element-map
 102           (org-test-with-expanded-babel-code (org-element-parse-buffer))
 103           'src-block
 104         (lambda (src) (org-trim (org-element-property :value src))))))))
 105
 106 (ert-deftest ob-exp/noweb-on-export-with-exports-results ()
 107   "Noweb header arguments export correctly using :exports results.
 108 - yes      expand on both export and tangle
 109 - no       expand on neither export or tangle
 110 - tangle   expand on only tangle not export"
 111   (should
 112    (equal
 113     '(";; noweb-no-start
 114   <<noweb-example1>>" "<<noweb-example1>>
 115 <<noweb-example2>>")
 116     (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d"
 117       (org-narrow-to-subtree)
 118       (org-element-map
 119           (org-test-with-expanded-babel-code (org-element-parse-buffer))
 120           'src-block
 121         (lambda (src) (org-trim (org-element-property :value src))))))))
 122
 123 (ert-deftest ob-exp/exports-both ()
 124   "Test the \":exports both\" header argument.
 125 The code block evaluation should create both a code block and
 126 a table."
 127   (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
 128     (org-narrow-to-subtree)
 129     (let ((tree (org-test-with-expanded-babel-code (org-element-parse-buffer))))
 130       (should (and (org-element-map tree 'src-block 'identity)
 131                    (org-element-map tree 'table 'identity))))))
 132
 133 (ert-deftest ob-exp/mixed-blocks-with-exports-both ()
 134   (should
 135    (equal
 136     '(property-drawer plain-list src-block fixed-width src-block plain-list)
 137     (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
 138       (org-narrow-to-subtree)
 139       (mapcar 'org-element-type
 140               (org-element-map
 141                   (org-test-with-expanded-babel-code
 142                    (org-element-parse-buffer 'greater-element))
 143                   'section 'org-element-contents nil t))))))
 144
 145 (ert-deftest ob-exp/export-with-name ()
 146   (should
 147    (string-match
 148     "=qux="
 149     (let ((org-babel-exp-code-template
 150            "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
 151       (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
 152         (org-narrow-to-subtree)
 153         (org-test-with-expanded-babel-code
 154          (buffer-string)))))))
 155
 156 (ert-deftest ob-exp/export-with-header-argument ()
 157   (let ((org-babel-exp-code-template
 158          "
 159 | header  | value    |
 160 |---------+----------|
 161 | foo     | %foo     |
 162 | results | %results |
 163 #+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
 164     (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
 165       (org-narrow-to-subtree)
 166       (org-test-with-expanded-babel-code
 167        (should (string-match "baz" (buffer-string)))
 168        (should (string-match "replace" (buffer-string)))))))
 169
 170 (ert-deftest ob-exp/noweb-no-export-and-exports-both ()
 171   (should
 172    (string-match
 173     "<<noweb-no-export-and-exports-both-1>>"
 174     (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
 175       (org-narrow-to-subtree)
 176       (org-test-with-expanded-babel-code
 177        (org-element-map (org-element-parse-buffer) 'src-block
 178          (lambda (src-block) (org-element-property :value src-block))
 179          nil t))))))
 180
 181 (ert-deftest ob-exp/evaluate-all-executables-in-order ()
 182   (should
 183    (equal '(5 4 3 2 1)
 184           (let (*evaluation-collector*)
 185             (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
 186               (org-narrow-to-subtree)
 187               (buffer-string)
 188               (fboundp 'org-export-execute-babel-code)
 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 =1= of a line.
 195 Here is one at the end of a line. =2=
 196 =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       (org-test-with-expanded-babel-code (buffer-string))))))
 200
 201 (ert-deftest ob-exp/export-call-line-information ()
 202   (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
 203     (org-narrow-to-subtree)
 204     (let ((org-babel-exp-call-line-template "\n: call: %line special-token"))
 205       (org-test-with-expanded-babel-code
 206        (should (string-match "double" (buffer-string)))
 207        (should (string-match "16" (buffer-string)))
 208        (should (string-match "special-token" (buffer-string)))))))
 209
 210 (ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
 211   (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
 212     (org-narrow-to-subtree)
 213     (org-babel-next-src-block 2)
 214     (should (= 110 (org-babel-execute-src-block)))
 215     (let ((result (org-test-with-expanded-babel-code (buffer-string))))
 216       (should-not (string-match (regexp-quote "<<strip-export-1>>") result))
 217       (should-not (string-match (regexp-quote "i=\"10\"") result)))))
 218
 219 (ert-deftest ob-exp/use-case-of-reading-entry-properties ()
 220   (org-test-at-id "cc5fbc20-bca5-437a-a7b8-2b4d7a03f820"
 221     (org-narrow-to-subtree)
 222     (let* ((case-fold-search nil)
 223            (result (org-test-with-expanded-babel-code (buffer-string)))
 224            (sect "a:1, b:0, c:3, d:0, e:0")
 225            (sub0 "a:1, b:2, c:4, d:0, e:0")
 226            (sub1 "a:1, b:2, c:5, d:0, e:6")
 227            (func sub0))
 228       ;; entry "section"
 229       (should (string-match (concat "_shell sect call\n: shell " sect "\n")
 230                             result))
 231       (should (string-match (concat "_elisp sect call\n: elisp " sect "\n")
 232                             result))
 233       (should (string-match (concat "\n- sect inline =shell " sect "=\n")
 234                             result))
 235       (should (string-match (concat "\n- sect inline =elisp " sect "=\n")
 236                             result))
 237       ;; entry "subsection", call without arguments
 238       (should (string-match (concat "_shell sub0 call\n: shell " sub0 "\n")
 239                             result))
 240       (should (string-match (concat "_elisp sub0 call\n: elisp " sub0 "\n")
 241                             result))
 242       (should (string-match (concat "\n- sub0 inline =shell " sub0 "=\n")
 243                             result))
 244       (should (string-match (concat "\n- sub0 inline =elisp " sub0 "=\n")
 245                             result))
 246       ;; entry "subsection", call with arguments
 247       (should (string-match (concat "_shell sub1 call\n: shell " sub1 "\n")
 248                             result))
 249       (should (string-match (concat "_elisp sub1 call\n: elisp " sub1 "\n")
 250                             result))
 251       (should (string-match (concat "\n- sub1 inline =shell " sub1 "=\n")
 252                             result))
 253       (should (string-match (concat "\n- sub1 inline =elisp " sub1 "=\n")
 254                             result))
 255       ;; entry "function definition"
 256       (should (string-match (concat "_location_shell\n: shell " func "\n")
 257                             result))
 258       (should (string-match (concat "_location_elisp\n: elisp " func "\n")
 259                             result)))))
 260
 261 (ert-deftest ob-exp/export-from-a-temp-buffer ()
 262   :expected-result :failed
 263   (org-test-with-temp-text
 264       "
 265 #+Title: exporting from a temporary buffer
 266
 267 #+name: foo
 268 #+BEGIN_SRC emacs-lisp
 269   :foo
 270 #+END_SRC
 271
 272 #+name: bar
 273 #+BEGIN_SRC emacs-lisp
 274   :bar
 275 #+END_SRC
 276
 277 #+BEGIN_SRC emacs-lisp :var foo=foo :noweb yes :exports results
 278   (list foo <<bar>>)
 279 #+END_SRC
 280 "
 281     (let* ((ascii (org-export-as 'ascii)))
 282       (should (string-match (regexp-quote (format nil "%S" '(:foo :bar)))
 283                             ascii)))))
 284
 285 (ert-deftest ob-export/export-with-results-before-block ()
 286   "Test export when results are inserted before source block."
 287   (should
 288    (equal
 289     "#+RESULTS: src1
 290 : 2
 291
 292 #+NAME: src1
 293 #+BEGIN_SRC emacs-lisp
 294 \(+ 1 1)
 295 #+END_SRC"
 296     (org-test-with-temp-text
 297         "#+RESULTS: src1
 298
 299 #+NAME: src1
 300 #+BEGIN_SRC emacs-lisp :exports both
 301 \(+ 1 1)
 302 #+END_SRC"
 303       (org-export-execute-babel-code)
 304       (buffer-string)))))
 305
 306 (ert-deftest ob-export/export-src-block-with-switches ()
 307   "Test exporting a source block with switches."
 308   (should
 309    (string-match
 310     "\\`#\\+BEGIN_SRC emacs-lisp -n -r$"
 311     (org-test-with-temp-text
 312         "#+BEGIN_SRC emacs-lisp -n -r\n\(+ 1 1)\n#+END_SRC"
 313       (org-export-execute-babel-code)
 314       (buffer-string)))))
 315
 316 (ert-deftest ob-export/export-src-block-with-flags ()
 317   "Test exporting a source block with a flag."
 318   (should
 319    (string-match
 320     "\\`#\\+BEGIN_SRC emacs-lisp -some-flag$"
 321     (org-test-with-temp-text
 322         "#+BEGIN_SRC emacs-lisp :flags -some-flag\n\(+ 1 1)\n#+END_SRC"
 323       (org-export-execute-babel-code)
 324       (buffer-string)))))
 325
 326 (ert-deftest ob-export/export-and-indentation ()
 327   "Test indentation of evaluated source blocks during export."
 328   ;; No indentation.
 329   (should
 330    (string-match
 331     "^t"
 332     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 333       (let ((indent-tabs-mode t)
 334             (tab-width 1)
 335             (org-src-preserve-indentation nil))
 336         (org-export-execute-babel-code)
 337         (buffer-string)))))
 338   ;; Preserve indentation with "-i" flag.
 339   (should
 340    (string-match
 341     "^ t"
 342     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n t\n#+END_SRC"
 343       (let ((indent-tabs-mode t)
 344             (tab-width 1))
 345         (org-export-execute-babel-code)
 346         (buffer-string)))))
 347   ;; Preserve indentation with a non-nil
 348   ;; `org-src-preserve-indentation'.
 349   (should
 350    (string-match
 351     "^ t"
 352     (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n t\n#+END_SRC"
 353       (let ((indent-tabs-mode t)
 354             (tab-width 1)
 355             (org-src-preserve-indentation t))
 356         (org-export-execute-babel-code)
 357         (buffer-string))))))
 358
 359 (ert-deftest ob-export/export-under-commented-headline ()
 360   "Test evaluation of code blocks under COMMENT headings."
 361   ;; Do not eval block in a commented headline.
 362   (should
 363    (string-match
 364     ": 2"
 365     (org-test-with-temp-text "* Headline
 366 #+BEGIN_SRC emacs-lisp :exports results
 367 \(+ 1 1)
 368 #+END_SRC"
 369       (org-export-execute-babel-code)
 370       (buffer-string))))
 371   (should-not
 372    (string-match
 373     ": 2"
 374     (org-test-with-temp-text "* COMMENT Headline
 375 #+BEGIN_SRC emacs-lisp :exports results
 376 \(+ 1 1)
 377 #+END_SRC"
 378       (org-export-execute-babel-code)
 379       (buffer-string))))
 380   ;; Do not eval inline blocks either.
 381   (should
 382    (string-match
 383     "=2="
 384     (org-test-with-temp-text "* Headline
 385 src_emacs-lisp{(+ 1 1)}"
 386       (org-export-execute-babel-code)
 387       (buffer-string))))
 388   (should-not
 389    (string-match
 390     "=2="
 391     (org-test-with-temp-text "* COMMENT Headline
 392 src_emacs-lisp{(+ 1 1)}"
 393       (org-export-execute-babel-code)
 394       (buffer-string))))
 395   ;; Also check parent headlines.
 396   (should-not
 397    (string-match
 398     ": 2"
 399     (org-test-with-temp-text "
 400 * COMMENT Headline
 401 ** Children
 402 #+BEGIN_SRC emacs-lisp :exports results
 403 \(+ 1 1)
 404 #+END_SRC"
 405       (org-export-execute-babel-code)
 406       (buffer-string)))))
 407
 408
 409 (provide 'test-ob-exp)
 410
 411 ;;; test-ob-exp.el ends here