242 lines
9.1 KiB
EmacsLisp
242 lines
9.1 KiB
EmacsLisp
;;; test-ob.el --- tests for ob.el
|
|
|
|
;; Copyright (c) 2010 Eric Schulte
|
|
;; Authors: Eric Schulte, Martyn Jago
|
|
|
|
;; Released under the GNU General Public License version 3
|
|
;; see: http://www.gnu.org/licenses/gpl-3.0.html
|
|
|
|
(let ((load-path (cons (expand-file-name
|
|
".." (file-name-directory
|
|
(or load-file-name buffer-file-name)))
|
|
load-path)))
|
|
(require 'org-test)
|
|
(require 'org-test-ob-consts))
|
|
(require 'org-test)
|
|
|
|
(ert-deftest test-org-babel/src-name-regexp ()
|
|
(should(equal "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
|
|
org-babel-src-name-regexp))
|
|
(mapcar (lambda (name)
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-name-regexp
|
|
(concat
|
|
" \t #+"
|
|
name
|
|
": \t src-name \t blah blah blah ")))
|
|
(should (string-match
|
|
org-babel-src-name-regexp
|
|
(concat
|
|
"#+" (upcase name)
|
|
": src-name")))
|
|
;;TODO This should fail no?
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-name-regexp
|
|
(concat
|
|
"#+" name ":")))
|
|
;;TODO Check - should this pass?
|
|
(should (not (org-test-string-exact-match
|
|
org-babel-src-name-regexp
|
|
(concat
|
|
"#+" name " : src-name")))))
|
|
'("srcname" "source" "function"))
|
|
(should (not (org-test-string-exact-match
|
|
org-babel-src-name-regexp
|
|
"#+invalid-name: src-name"))))
|
|
|
|
(ert-deftest test-org-babel/multi-line-header-regexp ()
|
|
(should(equal "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
|
|
org-babel-multi-line-header-regexp))
|
|
;;TODO can be optimised - and what about blah4 blah5 blah6?
|
|
(should (string-match
|
|
org-babel-multi-line-header-regexp
|
|
" \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))
|
|
(should
|
|
(equal
|
|
"blah1 blah2 blah3 \t"
|
|
(match-string
|
|
1
|
|
" \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))
|
|
|
|
;;TODO Check - should this fail?
|
|
(should (not (org-test-string-exact-match
|
|
org-babel-multi-line-header-regexp
|
|
" \t #+headers : blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
|
|
|
|
(ert-deftest test-org-babel/src-name-w-name-regexp ()
|
|
(should(equal
|
|
(concat org-babel-src-name-regexp "\\("
|
|
org-babel-multi-line-header-regexp "\\)*"
|
|
"\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
|
|
org-babel-src-name-w-name-regexp))
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-name-w-name-regexp
|
|
(concat
|
|
"#+srcname: src-name "
|
|
"#+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
|
|
|
|
(ert-deftest test-org-babel/src-block-regexp ()
|
|
(let ((test-block
|
|
(concat
|
|
"#+begin_src language -n-r-a-b -c :argument-1 yes :argument-2 no\n"
|
|
"echo this is a test\n"
|
|
"echo Currently in ' $PWD\n"
|
|
"#+end_src"))
|
|
(language "language")
|
|
(flags "-n-r-a-b -c ")
|
|
(arguments ":argument-1 yes :argument-2 no")
|
|
(body "echo this is a test\necho Currently in ' $PWD\n"))
|
|
(should (string-match org-babel-src-block-regexp test-block))
|
|
(should (string-match org-babel-src-block-regexp (upcase test-block)))
|
|
(should (equal language (match-string 2 test-block)))
|
|
;;TODO Consider refactoring
|
|
(should (equal flags (match-string 3 test-block)))
|
|
(should (equal arguments (match-string 4 test-block)))
|
|
(should (equal body (match-string 5 test-block)))
|
|
;;no switches
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-block-regexp
|
|
(replace-regexp-in-string flags "" test-block)))
|
|
;;no header arguments
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-block-regexp
|
|
(replace-regexp-in-string arguments "" test-block)))
|
|
;; should be valid with no body
|
|
(should (org-test-string-exact-match
|
|
org-babel-src-block-regexp
|
|
(replace-regexp-in-string body "" test-block)))))
|
|
|
|
(ert-deftest test-org-babel/get-header ()
|
|
(should (not (org-babel-get-header
|
|
org-babel-default-header-args :doesnt-exist)))
|
|
(should(equal '((:session . "none"))
|
|
(org-babel-get-header
|
|
org-babel-default-header-args :session)))
|
|
(should(equal '((:session . "none"))
|
|
(org-babel-get-header
|
|
org-babel-default-header-args :session nil)))
|
|
(should (not (org-babel-get-header
|
|
org-babel-default-header-args :SESSION)))
|
|
(should (equal '((:tangle . "no"))
|
|
(org-babel-get-header
|
|
org-babel-default-header-args :tangle)))
|
|
;; with OTHERS option
|
|
(should (equal org-babel-default-header-args
|
|
(org-babel-get-header
|
|
org-babel-default-header-args :doesnt-exist 'others)))
|
|
(should (equal org-babel-default-header-args
|
|
(org-babel-get-header
|
|
org-babel-default-header-args nil 'others)))
|
|
(should (null
|
|
(assoc :noweb
|
|
(org-babel-get-header
|
|
org-babel-default-header-args :noweb 'others)))))
|
|
|
|
(ert-deftest test-org-babel/default-inline-header-args ()
|
|
(should(equal
|
|
'((:session . "none") (:results . "replace") (:exports . "results"))
|
|
org-babel-default-inline-header-args)))
|
|
|
|
;;; ob-get-src-block-info
|
|
(ert-deftest test-org-babel/get-src-block-info-language ()
|
|
(org-test-at-marker nil org-test-file-ob-anchor
|
|
(let ((info (org-babel-get-src-block-info)))
|
|
(should (string= "emacs-lisp" (nth 0 info))))))
|
|
|
|
(ert-deftest test-org-babel/get-src-block-info-body ()
|
|
(org-test-at-marker nil org-test-file-ob-anchor
|
|
(let ((info (org-babel-get-src-block-info)))
|
|
(should (string-match (regexp-quote org-test-file-ob-anchor)
|
|
(nth 1 info))))))
|
|
|
|
(ert-deftest test-org-babel/get-src-block-info-tangle ()
|
|
(org-test-at-marker nil org-test-file-ob-anchor
|
|
(let ((info (org-babel-get-src-block-info)))
|
|
(should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
|
|
|
|
(ert-deftest test-org-babel/elisp-in-header-arguments ()
|
|
"Test execution of elisp forms in header arguments."
|
|
;; at the babel.org:elisp-forms-in-header-arguments header
|
|
(org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
|
|
(org-babel-next-src-block)
|
|
(let ((info (org-babel-get-src-block-info)))
|
|
(should (= 4 (org-babel-execute-src-block))))))
|
|
|
|
(ert-deftest test-org-babel/simple-named-code-block ()
|
|
"Test that simple named code blocks can be evaluated."
|
|
(org-test-at-id "0d82b52d-1bb9-4916-816b-2c67c8108dbb"
|
|
(org-babel-next-src-block 1)
|
|
(should (= 42 (org-babel-execute-src-block)))))
|
|
|
|
(ert-deftest test-org-babel/simple-variable-resolution ()
|
|
"Test that simple variable resolution is working."
|
|
(org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
|
|
(org-babel-next-src-block 2)
|
|
(should (= 4 (org-babel-execute-src-block)))))
|
|
|
|
(ert-deftest test-org-babel/multi-line-header-arguments ()
|
|
"Test that multi-line header arguments and can be read."
|
|
(org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
|
|
(org-babel-next-src-block)
|
|
(let ((results (org-babel-execute-src-block)))
|
|
(should(equal 'a (cadr (assoc 1 results))))
|
|
(should(equal 'd (cadr (assoc 4 results)))))))
|
|
|
|
(ert-deftest test-org-babel/parse-header-args ()
|
|
(org-test-at-id "7eb0dc6e-1c53-4275-88b3-b22f3113b9c3"
|
|
(org-babel-next-src-block)
|
|
(let* ((info (org-babel-get-src-block-info))
|
|
(params (nth 2 info)))
|
|
(message "%S" params)
|
|
(should(equal "example-lang" (nth 0 info)))
|
|
(should(string= "the body" (org-babel-trim (nth 1 info))))
|
|
(should-not (member '(:session\ \ \ \ ) params))
|
|
(should(equal '(:session) (assoc :session params)))
|
|
(should(equal '(:result-type . output) (assoc :result-type params)))
|
|
(should(equal '(num . 9) (cdr (assoc :var params)))))))
|
|
|
|
(ert-deftest test-org-babel/parse-header-args2 ()
|
|
(org-test-at-id "2409e8ba-7b5f-4678-8888-e48aa02d8cb4"
|
|
(should (string-match (regexp-quote "this is simple")
|
|
(org-babel-ref-resolve "simple-subtree")))
|
|
(org-babel-next-src-block)
|
|
(should (= 14 (org-babel-execute-src-block)))))
|
|
|
|
(ert-deftest test-org-babel/inline-src-blocks ()
|
|
(org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
|
|
(flet ((next ()
|
|
(move-end-of-line 1)
|
|
(re-search-forward org-babel-inline-src-block-regexp nil t)
|
|
(goto-char (match-beginning 1))))
|
|
(next) (should (equal 1 (org-babel-execute-src-block)))
|
|
(next) (should (equal 2 (org-babel-execute-src-block)))
|
|
(next) (should (equal 3 (org-babel-execute-src-block))))))
|
|
|
|
(ert-deftest test-org-babel/org-babel-get-inline-src-block-matches ()
|
|
(org-test-at-id "0D0983D4-DE33-400A-8A05-A225A567BC74"
|
|
(let ((test-point (point)))
|
|
(should (fboundp 'org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward "src_" nil t)) ;; 1
|
|
(should (= (+ test-point 140) (match-end 0)))
|
|
(should (org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward "}" nil (point-at-bol))) ;; 1
|
|
(should-not (org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward "in" nil t)) ;; 2
|
|
(should-not (org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward "echo" nil t)) ;; 2
|
|
(should (org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward "blocks" nil t)) ;; 3
|
|
(left-char 8) ;; 3
|
|
(should (org-babel-get-inline-src-block-matches))
|
|
(right-char 1) ;;3
|
|
(should-not (org-babel-get-inline-src-block-matches))
|
|
(should (re-search-forward ":results" nil t)) ;; 4
|
|
(should (org-babel-get-inline-src-block-matches))
|
|
(end-of-line)
|
|
(should-not (org-babel-get-inline-src-block-matches))
|
|
)))
|
|
|
|
(provide 'test-ob)
|
|
|
|
;;; test-ob ends here
|