testing/lisp/test-ob.el

   1 ;;; test-ob.el --- tests for ob.el
   2
   3 ;; Copyright (c) 2010 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   (require 'org-test)
  16
  17 (ert-deftest test-org-babel/src-name-regexp ()
  18   (should(equal "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
  19                 org-babel-src-name-regexp))
  20   (mapcar (lambda (name)
  21             (should (org-test-string-exact-match
  22                      org-babel-src-name-regexp
  23                      (concat
  24                       "   \t #+"
  25                       name
  26                       ":    \t src-name \t blah blah blah ")))
  27             (should (string-match
  28                      org-babel-src-name-regexp
  29                      (concat
  30                       "#+" (upcase name)
  31                       ": src-name")))
  32             ;;TODO This should fail no?
  33             (should (org-test-string-exact-match
  34                      org-babel-src-name-regexp
  35                      (concat
  36                       "#+" name ":")))
  37             ;;TODO Check - should this pass?
  38             (should (not (org-test-string-exact-match
  39                           org-babel-src-name-regexp
  40                           (concat
  41                            "#+" name " : src-name")))))
  42           '("srcname" "source" "function"))
  43   (should (not  (org-test-string-exact-match
  44                  org-babel-src-name-regexp
  45                  "#+invalid-name: src-name"))))
  46
  47 (ert-deftest test-org-babel/multi-line-header-regexp ()
  48   (should(equal "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
  49                 org-babel-multi-line-header-regexp))
  50   ;;TODO can be optimised - and what about blah4 blah5 blah6?
  51   (should (string-match
  52            org-babel-multi-line-header-regexp
  53            "   \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))
  54   (should
  55    (equal
  56     "blah1 blah2 blah3 \t"
  57     (match-string
  58      1
  59      "   \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))
  60
  61   ;;TODO Check - should this fail?
  62   (should (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
 110 (ert-deftest test-org-babel/inline-src-block-regexp ()
 111   (should(equal (concat "[^-[:alnum:]]\\(src_\\([^ \f\t\n\r\v]+\\)"
 112                         "\\(\\|\\[\\(.*?\\)\\]\\)"
 113                         "{\\([^\f\n\r\v]+?\\)}\\)")
 114                 org-babel-inline-src-block-regexp))
 115   ;; (should (org-test-string-exact-match
 116   ;;       org-babel-inline-src-block-regexp
 117   ;;       "src_lang[:testing1 yes :testing2 no]{ echo This is a test }\n"))
 118   )
 119
 120 (ert-deftest test-org-babel/get-header ()
 121   (should (not (org-babel-get-header
 122                 org-babel-default-header-args :doesnt-exist)))
 123   (should(equal '((:session . "none"))
 124                 (org-babel-get-header
 125                  org-babel-default-header-args :session)))
 126   (should(equal '((:session . "none"))
 127                 (org-babel-get-header
 128                  org-babel-default-header-args :session nil)))
 129   (should (not (org-babel-get-header
 130                 org-babel-default-header-args :SESSION)))
 131   (should (equal '((:tangle . "no"))
 132                  (org-babel-get-header
 133                   org-babel-default-header-args :tangle)))
 134   ;; with OTHERS option
 135   (should (equal org-babel-default-header-args
 136                  (org-babel-get-header
 137                   org-babel-default-header-args :doesnt-exist 'others)))
 138   (should (equal org-babel-default-header-args
 139                  (org-babel-get-header
 140                   org-babel-default-header-args nil 'others)))
 141   (should (null
 142            (assoc :noweb
 143                   (org-babel-get-header
 144                    org-babel-default-header-args :noweb 'others)))))
 145
 146 (ert-deftest test-org-babel/default-inline-header-args ()
 147   (should(equal
 148           '((:session . "none") (:results . "replace") (:exports . "results"))
 149           org-babel-default-inline-header-args)))
 150
 151 ;;; ob-get-src-block-info
 152 (ert-deftest test-org-babel/get-src-block-info-language ()
 153   (org-test-at-marker nil org-test-file-ob-anchor
 154     (let ((info (org-babel-get-src-block-info)))
 155       (should (string= "emacs-lisp" (nth 0 info))))))
 156
 157 (ert-deftest test-org-babel/get-src-block-info-body ()
 158   (org-test-at-marker nil org-test-file-ob-anchor
 159     (let ((info (org-babel-get-src-block-info)))
 160       (should (string-match (regexp-quote org-test-file-ob-anchor)
 161                             (nth 1 info))))))
 162
 163 (ert-deftest test-org-babel/get-src-block-info-tangle ()
 164   (org-test-at-marker nil org-test-file-ob-anchor
 165     (let ((info (org-babel-get-src-block-info)))
 166       (should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
 167
 168 (ert-deftest test-org-babel/elisp-in-header-arguments ()
 169   "Test execution of elisp forms in header arguments."
 170   ;; at the babel.org:elisp-forms-in-header-arguments header
 171   (org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
 172     (org-babel-next-src-block)
 173     (let ((info (org-babel-get-src-block-info)))
 174       (should (= 4 (org-babel-execute-src-block))))))
 175
 176 (ert-deftest test-org-babel/simple-named-code-block ()
 177   "Test that simple named code blocks can be evaluated."
 178   (org-test-at-id "0d82b52d-1bb9-4916-816b-2c67c8108dbb"
 179     (org-babel-next-src-block 1)
 180     (should (= 42 (org-babel-execute-src-block)))))
 181
 182 (ert-deftest test-org-babel/simple-variable-resolution ()
 183   "Test that simple variable resolution is working."
 184   (org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
 185     (org-babel-next-src-block 2)
 186     (should (= 4 (org-babel-execute-src-block)))))
 187
 188 (ert-deftest test-org-babel/multi-line-header-arguments ()
 189   "Test that multi-line header arguments and can be read."
 190   (org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
 191     (org-babel-next-src-block)
 192     (let ((results (org-babel-execute-src-block)))
 193       (should(equal 'a (cadr (assoc 1 results))))
 194       (should(equal 'd (cadr (assoc 4 results)))))))
 195
 196 (ert-deftest test-org-babel/parse-header-args ()
 197   (org-test-at-id "7eb0dc6e-1c53-4275-88b3-b22f3113b9c3"
 198     (org-babel-next-src-block)
 199     (let* ((info (org-babel-get-src-block-info))
 200            (params (nth 2 info)))
 201       (message "%S" params)
 202       (should(equal "example-lang" (nth 0 info)))
 203       (should(string= "the body" (org-babel-trim (nth 1 info))))
 204       (should-not (member '(:session\ \ \ \ ) params))
 205       (should(equal '(:session) (assoc :session params)))
 206       (should(equal '(:result-type . output) (assoc :result-type params)))
 207       (should(equal '(num . 9) (cdr (assoc :var params)))))))
 208
 209 (provide 'test-ob)
 210
 211 ;;; test-ob ends here