testing/lisp/test-ob.el

   1 ;;; test-ob.el --- tests for ob.el
   2
   3 ;; Copyright (c) 2010, 2011 Eric Schulte
   4 ;; Authors: Eric Schulte, Martyn Jago
   5
   6 ;; Released under the GNU General Public License version 3
   7 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
   8
   9 (let ((load-path (cons (expand-file-name
  10                         ".." (file-name-directory
  11                               (or load-file-name buffer-file-name)))
  12                        load-path)))
  13   (require 'org-test)
  14   (require 'org-test-ob-consts))
  15
  16 (ert-deftest test-org-babel/src-name-regexp ()
  17   (should(equal "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
  18                 org-babel-src-name-regexp))
  19   (mapcar (lambda (name)
  20             (should (org-test-string-exact-match
  21                      org-babel-src-name-regexp
  22                      (concat
  23                       "   \t #+"
  24                       name
  25                       ":    \t src-name \t blah blah blah ")))
  26             (should (string-match
  27                      org-babel-src-name-regexp
  28                      (concat
  29                       "#+" (upcase name)
  30                       ": src-name")))
  31             ;;TODO This should fail no?
  32             (should (org-test-string-exact-match
  33                      org-babel-src-name-regexp
  34                      (concat
  35                       "#+" name ":")))
  36             ;;TODO Check - should this pass?
  37             (should (not (org-test-string-exact-match
  38                           org-babel-src-name-regexp
  39                           (concat
  40                            "#+" name " : src-name")))))
  41           '("srcname" "source" "function"))
  42   (should (not  (org-test-string-exact-match
  43                  org-babel-src-name-regexp
  44                  "#+invalid-name: src-name"))))
  45
  46 (ert-deftest test-org-babel/multi-line-header-regexp ()
  47   (should(equal "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
  48                 org-babel-multi-line-header-regexp))
  49   ;;TODO can be optimised - and what about blah4 blah5 blah6?
  50   (should (string-match
  51            org-babel-multi-line-header-regexp
  52            "   \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))
  53   (should
  54    (equal
  55     "blah1 blah2 blah3 \t"
  56     (match-string
  57      1
  58      "   \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))
  59
  60   ;;TODO Check - should this fail?
  61   (should
  62    (not (org-test-string-exact-match
  63          org-babel-multi-line-header-regexp
  64          "   \t #+headers : blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
  65
  66 (ert-deftest test-org-babel/src-name-w-name-regexp ()
  67   (should(equal
  68           (concat org-babel-src-name-regexp "\\("
  69                   org-babel-multi-line-header-regexp "\\)*"
  70                   "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
  71           org-babel-src-name-w-name-regexp))
  72   (should (org-test-string-exact-match
  73            org-babel-src-name-w-name-regexp
  74            (concat
  75             "#+srcname: src-name "
  76             "#+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
  77
  78 (ert-deftest test-org-babel/src-block-regexp ()
  79   (let ((test-block
  80          (concat
  81           "#+begin_src language -n-r-a-b -c :argument-1 yes :argument-2 no\n"
  82           "echo this is a test\n"
  83           "echo Currently in ' $PWD\n"
  84           "#+end_src"))
  85         (language "language")
  86         (flags "-n-r-a-b -c ")
  87         (arguments ":argument-1 yes :argument-2 no")
  88         (body "echo this is a test\necho Currently in ' $PWD\n"))
  89     (should (string-match org-babel-src-block-regexp test-block))
  90     (should (string-match org-babel-src-block-regexp (upcase test-block)))
  91     (should (equal language (match-string 2 test-block)))
  92     ;;TODO Consider refactoring
  93     (should (equal flags (match-string 3 test-block)))
  94     (should (equal arguments (match-string 4 test-block)))
  95     (should (equal body (match-string 5 test-block)))
  96     ;;no switches
  97     (should (org-test-string-exact-match
  98              org-babel-src-block-regexp
  99              (replace-regexp-in-string flags "" test-block)))
 100     ;;no header arguments
 101     (should (org-test-string-exact-match
 102              org-babel-src-block-regexp
 103              (replace-regexp-in-string arguments "" test-block)))
 104     ;; should be valid with no body
 105     (should (org-test-string-exact-match
 106              org-babel-src-block-regexp
 107              (replace-regexp-in-string body "" test-block)))))
 108
 109 (ert-deftest test-org-babel/get-header ()
 110   (should (not (org-babel-get-header
 111                 org-babel-default-header-args :doesnt-exist)))
 112   (should(equal '((:session . "none"))
 113                 (org-babel-get-header
 114                  org-babel-default-header-args :session)))
 115   (should(equal '((:session . "none"))
 116                 (org-babel-get-header
 117                  org-babel-default-header-args :session nil)))
 118   (should (not (org-babel-get-header
 119                 org-babel-default-header-args :SESSION)))
 120   (should (equal '((:tangle . "no"))
 121                  (org-babel-get-header
 122                   org-babel-default-header-args :tangle)))
 123   ;; with OTHERS option
 124   (should (equal org-babel-default-header-args
 125                  (org-babel-get-header
 126                   org-babel-default-header-args :doesnt-exist 'others)))
 127   (should (equal org-babel-default-header-args
 128                  (org-babel-get-header
 129                   org-babel-default-header-args nil 'others)))
 130   (should (null
 131            (assoc :noweb
 132                   (org-babel-get-header
 133                    org-babel-default-header-args :noweb 'others)))))
 134
 135 (ert-deftest test-org-babel/default-inline-header-args ()
 136   (should(equal
 137           '((:session . "none") (:results . "replace") (:exports . "results"))
 138           org-babel-default-inline-header-args)))
 139
 140 ;;; ob-get-src-block-info
 141 (ert-deftest test-org-babel/get-src-block-info-language ()
 142   (org-test-at-marker nil org-test-file-ob-anchor
 143     (let ((info (org-babel-get-src-block-info)))
 144       (should (string= "emacs-lisp" (nth 0 info))))))
 145
 146 (ert-deftest test-org-babel/get-src-block-info-body ()
 147   (org-test-at-marker nil org-test-file-ob-anchor
 148     (let ((info (org-babel-get-src-block-info)))
 149       (should (string-match (regexp-quote org-test-file-ob-anchor)
 150                             (nth 1 info))))))
 151
 152 (ert-deftest test-org-babel/get-src-block-info-tangle ()
 153   (org-test-at-marker nil org-test-file-ob-anchor
 154     (let ((info (org-babel-get-src-block-info)))
 155       (should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
 156
 157 (ert-deftest test-org-babel/elisp-in-header-arguments ()
 158   "Test execution of elisp forms in header arguments."
 159   ;; at the babel.org:elisp-forms-in-header-arguments header
 160   (org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
 161     (org-babel-next-src-block)
 162     (let ((info (org-babel-get-src-block-info)))
 163       (should (= 4 (org-babel-execute-src-block))))))
 164
 165 (ert-deftest test-org-babel/simple-named-code-block ()
 166   "Test that simple named code blocks can be evaluated."
 167   (org-test-at-id "0d82b52d-1bb9-4916-816b-2c67c8108dbb"
 168     (org-babel-next-src-block 1)
 169     (should (= 42 (org-babel-execute-src-block)))))
 170
 171 (ert-deftest test-org-babel/simple-variable-resolution ()
 172   "Test that simple variable resolution is working."
 173   (org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
 174     (org-babel-next-src-block 2)
 175     (should (= 4 (org-babel-execute-src-block)))))
 176
 177 (ert-deftest test-org-babel/multi-line-header-arguments ()
 178   "Test that multi-line header arguments and can be read."
 179   (org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
 180     (org-babel-next-src-block)
 181     (let ((results (org-babel-execute-src-block)))
 182       (should(equal 'a (cadr (assoc 1 results))))
 183       (should(equal 'd (cadr (assoc 4 results)))))))
 184
 185 (ert-deftest test-org-babel/parse-header-args ()
 186   (org-test-at-id "7eb0dc6e-1c53-4275-88b3-b22f3113b9c3"
 187     (org-babel-next-src-block)
 188     (let* ((info (org-babel-get-src-block-info))
 189            (params (nth 2 info)))
 190       (message "%S" params)
 191       (should(equal "example-lang" (nth 0 info)))
 192       (should(string= "the body" (org-babel-trim (nth 1 info))))
 193       (should-not (member '(:session\ \ \ \ ) params))
 194       (should(equal '(:session) (assoc :session params)))
 195       (should(equal '(:result-type . output) (assoc :result-type params)))
 196       (should(equal '(num . 9) (cdr (assoc :var params)))))))
 197
 198 (ert-deftest test-org-babel/parse-header-args2 ()
 199   (org-test-at-id "2409e8ba-7b5f-4678-8888-e48aa02d8cb4"
 200     (should (string-match (regexp-quote "this is simple")
 201                           (org-babel-ref-resolve "simple-subtree")))
 202     (org-babel-next-src-block)
 203     (should (= 14 (org-babel-execute-src-block)))))
 204
 205 (ert-deftest test-org-babel/inline-src-blocks ()
 206   (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
 207     (macrolet ((at-next (&rest body)
 208                  `(progn
 209                     (move-end-of-line 1)
 210                     (re-search-forward org-babel-inline-src-block-regexp nil t)
 211                     (goto-char (match-beginning 1))
 212                     (save-match-data ,@body))))
 213       (at-next (should (equal 1 (org-babel-execute-src-block))))
 214       (at-next (should (equal 2 (org-babel-execute-src-block))))
 215       (at-next (should (equal 3 (org-babel-execute-src-block)))))))
 216
 217 (ert-deftest test-org-babel/org-babel-get-inline-src-block-matches ()
 218   (org-test-at-id "0D0983D4-DE33-400A-8A05-A225A567BC74"
 219     (let ((test-point (point)))
 220       (should (fboundp 'org-babel-get-inline-src-block-matches))
 221       (should (re-search-forward "src_" nil t)) ;; 1
 222       (should (= (+ test-point 140) (match-end 0)))
 223       (should (org-babel-get-inline-src-block-matches))
 224       (should (re-search-forward "}" nil (point-at-bol))) ;; 1
 225       (should-not (org-babel-get-inline-src-block-matches))
 226       (should (re-search-forward "in" nil t)) ;; 2
 227       (should-not (org-babel-get-inline-src-block-matches))
 228       (should (re-search-forward "echo" nil t)) ;; 2
 229       (should (org-babel-get-inline-src-block-matches))
 230       (should (re-search-forward "blocks" nil t)) ;; 3
 231       (backward-char 8) ;; 3
 232       (should (org-babel-get-inline-src-block-matches))
 233       (forward-char 1) ;;3
 234       (should-not (org-babel-get-inline-src-block-matches))
 235       (should (re-search-forward ":results" nil t)) ;; 4
 236       (should (org-babel-get-inline-src-block-matches))
 237       (end-of-line)
 238       (should-not (org-babel-get-inline-src-block-matches))
 239     )))
 240
 241 (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-1 ()
 242   (let ((test-line "src_sh{echo 1}"))
 243     ;; src_ at bol line 1...
 244     (org-test-with-temp-text
 245         test-line
 246       (goto-char (point-min)) (org-ctrl-c-ctrl-c)
 247       (should (string=
 248                (concat test-line " =1=")
 249                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 250       (forward-char) (org-ctrl-c-ctrl-c)
 251       (should (string=
 252                (concat test-line " =1= =1=")
 253                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 254       (re-search-forward "1}")
 255       (should-error (org-ctrl-c-ctrl-c))
 256       (backward-char) ;; last char of block body
 257       (org-ctrl-c-ctrl-c)
 258       (should (string=
 259                (concat test-line " =1= =1= =1=")
 260                (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))
 261     ;; src_ follows space line 1...
 262     (let ((test-line " src_emacs-lisp{ 1 }"))
 263     (org-test-with-temp-text
 264         test-line
 265       (should-error (org-ctrl-c-ctrl-c))
 266       (forward-char) (org-ctrl-c-ctrl-c)
 267       (should (string=
 268                (concat test-line " =1=")
 269                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 270       (re-search-forward "{ 1 ") (org-ctrl-c-ctrl-c)
 271       (should (string=
 272                (concat test-line " =1= =1=")
 273                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 274       (forward-char)
 275       (should-error (org-ctrl-c-ctrl-c)))))
 276
 277 (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-2 ()
 278   ;; src_ at bol line 2...
 279   (let ((test-line " src_emacs-lisp{ \"x\" }"))
 280     (org-test-with-temp-text
 281         (concat "\n" test-line)
 282       (should-error (org-ctrl-c-ctrl-c))
 283       (goto-char (point-min))
 284       (should-error (org-ctrl-c-ctrl-c))
 285       (forward-line)
 286       (should-error (org-ctrl-c-ctrl-c))
 287       (forward-char) (org-ctrl-c-ctrl-c)
 288       (should (string=
 289                (concat test-line " =x=")
 290                (buffer-substring-no-properties
 291                 (point-at-bol) (point-at-eol))))))
 292
 293   (let ((test-line "Some text prior to block src_emacs-lisp{ \"y\" }"))
 294     (org-test-with-temp-text
 295         test-line
 296       (goto-char (point-max))
 297       (insert (concat "\n" test-line " end"))
 298       (re-search-backward "src") (org-ctrl-c-ctrl-c)
 299       (should (string=
 300                (concat test-line " =y= end")
 301                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 302       (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
 303       (should (string=
 304                (concat test-line " =y= =y= end")
 305                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 306       (forward-char)
 307       (should-error (org-ctrl-c-ctrl-c))))))
 308
 309 (ert-deftest test-org-babel/inline-src_blk-manual-results-replace ()
 310   (let ((test-line " src_emacs-lisp[:results replace]{ \"x\" }"))
 311     (org-test-with-temp-text
 312         (concat "\n" test-line)
 313       (should-error (org-ctrl-c-ctrl-c))
 314       (goto-char (point-max))
 315       (should-error (org-ctrl-c-ctrl-c))
 316       (beginning-of-line)
 317       (should-error (org-ctrl-c-ctrl-c))
 318       (forward-char) (org-ctrl-c-ctrl-c)
 319       (should (string=
 320                (concat test-line " =x=")
 321                (buffer-substring-no-properties
 322                 (point-at-bol) (point-at-eol))))))
 323
 324   (let ((test-line (concat " Some text prior to block "
 325                            "src_emacs-lisp[:results replace]{ \"y\" }")))
 326     (org-test-with-temp-text test-line
 327       (goto-char (point-max))
 328       (insert (concat "\n" test-line " end"))
 329       (re-search-backward "src") (org-ctrl-c-ctrl-c)
 330       (should (string=
 331                (concat test-line " =y= end")
 332                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 333       (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
 334       (should (string=
 335                (concat test-line " =y= =y= end")
 336                (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
 337       (forward-char)
 338       (should-error (org-ctrl-c-ctrl-c)))))
 339
 340 (ert-deftest test-org-babel/inline-src_blk-results-silent ()
 341   (let ((test-line "src_emacs-lisp[ :results silent ]{ \"x\" }"))
 342     (org-test-with-temp-text test-line
 343       (org-ctrl-c-ctrl-c)
 344       (should (string= test-line
 345                        (buffer-substring-no-properties
 346                         (point-at-bol) (point-at-eol))))
 347       (end-of-buffer)
 348       (should-error (org-ctrl-c-ctrl-c))))
 349   (let ((test-line (concat " Some text prior to block src_emacs-lisp"
 350                            "[ :results silent ]{ \"y\" }")))
 351     (org-test-with-temp-text
 352         test-line
 353       (goto-char (point-max))
 354       (insert (concat "\n" test-line " end"))
 355       (re-search-backward "src_") (org-ctrl-c-ctrl-c)
 356       (should (string= (concat test-line " end")
 357                        (buffer-substring-no-properties
 358                         (point-at-bol) (point-at-eol))))
 359       (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
 360       (should (string= (concat test-line " end")
 361                        (buffer-substring-no-properties
 362                         (point-at-bol) (point-at-eol))))
 363       (forward-char)
 364       (should-error (org-ctrl-c-ctrl-c)))))
 365
 366 (ert-deftest test-org-babel/inline-src_blk-results-raw ()
 367   (let ((test-line "src_emacs-lisp[ :results raw ]{ \"x\" }"))
 368     (org-test-with-temp-text test-line
 369       (org-ctrl-c-ctrl-c)
 370       (should (string= (concat test-line " x")
 371                        (buffer-string)))))
 372   (let ((test-line (concat " Some text prior to block "
 373                            "src_emacs-lisp[ :results raw ]{ \"the\" }")))
 374     (org-test-with-temp-text (concat test-line " end")
 375       (re-search-forward "src_") (org-ctrl-c-ctrl-c)
 376       (should (string= (concat test-line " the end")
 377                        (buffer-substring-no-properties
 378                         (point-at-bol) (point-at-eol))))
 379       (re-search-forward "\" ") (org-ctrl-c-ctrl-c)
 380       (should (string= (concat test-line " the the end")
 381                        (buffer-substring-no-properties
 382                         (point-at-bol) (point-at-eol))))
 383       (forward-char)
 384       (should-error (org-ctrl-c-ctrl-c)))))
 385
 386 (ert-deftest test-org-babel/inline-src_blk-results-file ()
 387   (let ((test-line "src_emacs-lisp[ :results file ]{ \"~/test-file\"  }"))
 388     (org-test-with-temp-text
 389         test-line
 390       (org-ctrl-c-ctrl-c)
 391       (should (string= (concat test-line " [[file:~/test-file]]")
 392                        (buffer-substring-no-properties
 393                         (point-min) (point-max)))))))
 394
 395 (ert-deftest test-org-babel/inline-src_blk-results-scalar ()
 396   (let ((test-line "src_emacs-lisp[ :results scalar ]{ \"x\"  }"))
 397     (org-test-with-temp-text
 398         test-line
 399       (org-ctrl-c-ctrl-c)
 400       (should (string= (concat test-line  " =\"x\"=")
 401                        (buffer-substring-no-properties
 402                         (point-min) (point-max)))))))
 403
 404 (ert-deftest test-org-babel/inline-src_blk-results-verbatim ()
 405   (let ((test-line "src_emacs-lisp[ :results verbatim ]{ \"x\"  }"))
 406     (org-test-with-temp-text
 407         test-line
 408       (org-ctrl-c-ctrl-c)
 409       (should (string= (concat test-line " =\"x\"=")
 410                        (buffer-substring-no-properties
 411                         (point-min) (point-max)))))))
 412
 413 (ert-deftest test-org-babel/combining-scalar-and-raw-result-types ()
 414   (flet ((next-result ()
 415                       (org-babel-next-src-block)
 416                       (org-babel-execute-src-block)
 417                       (goto-char (org-babel-where-is-src-block-result))
 418                       (forward-line 1)))
 419     (org-test-at-id "a73a2ab6-b8b2-4c0e-ae7f-23ad14eab7bc"
 420       (next-result)
 421       (should (org-babel-in-example-or-verbatim))
 422       (next-result)
 423       (should (not (org-babel-in-example-or-verbatim))))))
 424
 425 (ert-deftest test-org-babel/no-defaut-value-for-var ()
 426   "Test that the absence of a default value for a variable DOES THROW
 427   a proper error."
 428   (org-test-at-id "f2df5ba6-75fa-4e6b-8441-65ed84963627"
 429     (org-babel-next-src-block)
 430     (let ((err
 431            (should-error (org-babel-execute-src-block) :type 'error)))
 432       (should
 433        (equal
 434         '(error
 435           "variable \"x\" in block \"carre\" must be assigned a default value")
 436         err)))))
 437
 438 (ert-deftest test-org-babel/just-one-results-block ()
 439   "Test that evaluating two times the same code block does not result in a
 440 duplicate results block."
 441   (org-test-with-temp-text "#+begin_src sh\necho Hello\n#+end_src\n"
 442     (org-babel-execute-src-block)
 443     (org-babel-execute-src-block)     ; second code block execution
 444     (should (search-forward "Hello")) ; the string inside the source code block
 445     (should (search-forward "Hello")) ; the same string in the results block
 446     (should-error (search-forward "Hello"))))
 447
 448 (provide 'test-ob)
 449
 450 ;;; test-ob ends here