ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Babel: code block may have empty bodies, now passing all tests 

* lisp/ob.el (org-babel-src-block-regexp): Babel: code block may have
  empty bodies.
* testing/lisp/test-ob-tangle.el
  (ob-tangle/no-excessive-id-insertion-on-tangle): Updated the ID.
* testing/lisp/test-ob.el (test-org-babel/src-block-regexp): Cleaned
  up the test.
  (test-org-babel/default-header-args): Removed trivial test.
  (test-org-babel/get-header): Indentation.
  (test-org-babel/sha1-hash): Updated Hash for new sorting schema.
This commit is contained in:
Eric Schulte 2011-06-14 13:39:20 -07:00
parent c83cfcc243
commit 978cdf276d
3 changed files with 36 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/ob.el
View File

@ -141,7 +141,7 @@ remove code block execution from the C-c C-c keybinding."
;; (4) header arguments ;; (4) header arguments
"\\([^\n]*\\)\n" "\\([^\n]*\\)\n"
;; (5) body ;; (5) body
"\\([^\000]*?\n\\)[ \t]*#\\+end_src") "\\([^\000]*?\\)[ \t]*#\\+end_src")
"Regexp used to identify code blocks.") "Regexp used to identify code blocks.")
(defvar org-babel-inline-src-block-regexp (defvar org-babel-inline-src-block-regexp

3
testing/lisp/test-ob-tangle.el
View File

@ -47,10 +47,9 @@
(ert-deftest ob-tangle/no-excessive-id-insertion-on-tangle () (ert-deftest ob-tangle/no-excessive-id-insertion-on-tangle ()
"Don't add IDs to headings without tangling code blocks." "Don't add IDs to headings without tangling code blocks."
(org-test-at-id "ae7b55ca-9ef2-4d30-bd48-da30e35fd0f3" (org-test-at-id "ef06fd7f-012b-4fde-87a2-2ae91504ea7e"
(org-babel-next-src-block) (org-babel-next-src-block)
(org-babel-tangle) (org-babel-tangle)
(org-babel-previous-src-block)
(should (null (org-id-get))))) (should (null (org-id-get)))))
(provide 'test-ob-tangle) (provide 'test-ob-tangle)

98
testing/lisp/test-ob.el
View File

@ -76,47 +76,23 @@
"#+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))) "#+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n"))))
(ert-deftest test-org-babel/src-block-regexp () (ert-deftest test-org-babel/src-block-regexp ()
(should(equal (let ((test-block
(concat "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" (concat
"\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" "#+begin_src language -n-r-a-b -c :argument-1 yes :argument-2 no\n"
"\\([^\n]*\\)\n" "echo this is a test\n"
"\\([^\000]*?\n*\\)[ \t]*#\\+end_src") "echo Currently in ' $PWD\n"
org-babel-src-block-regexp)) "#+end_src"))
(let ((test-block(concat (language "language")
"#+begin_src language -n-r-a-b -c :argument-1 yes :argument-2 no\n" (flags "-n-r-a-b -c ")
"echo this is a test\n" (arguments ":argument-1 yes :argument-2 no")
"echo Currently in ' $PWD" (body "echo this is a test\necho Currently in ' $PWD\n"))
"#+end_src")) (should (string-match org-babel-src-block-regexp test-block))
(language) (flags) (arguments) (body)) (should (string-match org-babel-src-block-regexp (upcase test-block)))
(should (string-match (should(equal language (match-string 2 test-block)))
org-babel-src-block-regexp
(upcase test-block)))
(should (string-match
org-babel-src-block-regexp
test-block))
(should(equal "language"
(setq language
(match-string
2
test-block))))
;;TODO Consider refactoring ;;TODO Consider refactoring
(should(equal "-n-r-a-b -c " (should (equal flags (match-string 3 test-block)))
(setq flags (match-string (should (equal arguments (match-string 4 test-block)))
3 (should (equal body (match-string 5 test-block)))
test-block))))
(should(equal ":argument-1 yes :argument-2 no"
(setq arguments (match-string
4
test-block))))
(should(equal "echo this is a test\necho Currently in ' $PWD"
(setq body (match-string
5
test-block))))
;;no language
;;TODO Is this a valid response?
(should (org-test-string-exact-match
org-babel-src-block-regexp
(replace-regexp-in-string language "" test-block)))
;;no switches ;;no switches
(should (org-test-string-exact-match (should (org-test-string-exact-match
org-babel-src-block-regexp org-babel-src-block-regexp
@ -125,10 +101,11 @@
(should (org-test-string-exact-match (should (org-test-string-exact-match
org-babel-src-block-regexp org-babel-src-block-regexp
(replace-regexp-in-string arguments "" test-block))) (replace-regexp-in-string arguments "" test-block)))
;;TODO Check this ...valid with no body? ;; should be valid with no body
(should (org-test-string-exact-match (should (org-test-string-exact-match
org-babel-src-block-regexp org-babel-src-block-regexp
(replace-regexp-in-string body "" test-block))))) (replace-regexp-in-string body "" test-block)))))
(ert-deftest test-org-babel/inline-src-block-regexp () (ert-deftest test-org-babel/inline-src-block-regexp ()
(should(equal (concat "[^-[:alnum:]]\\(src_\\([^ \f\t\n\r\v]+\\)" (should(equal (concat "[^-[:alnum:]]\\(src_\\([^ \f\t\n\r\v]+\\)"
@ -140,12 +117,6 @@
;; "src_lang[:testing1 yes :testing2 no]{ echo This is a test }\n")) ;; "src_lang[:testing1 yes :testing2 no]{ echo This is a test }\n"))
) )
(ert-deftest test-org-babel/default-header-args ()
(should
(equal '((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
org-babel-default-header-args)))
(ert-deftest test-org-babel/get-header () (ert-deftest test-org-babel/get-header ()
(should (not (org-babel-get-header (should (not (org-babel-get-header
org-babel-default-header-args :doesnt-exist))) org-babel-default-header-args :doesnt-exist)))
@ -157,21 +128,20 @@
org-babel-default-header-args :session nil))) org-babel-default-header-args :session nil)))
(should (not (org-babel-get-header (should (not (org-babel-get-header
org-babel-default-header-args :SESSION))) org-babel-default-header-args :SESSION)))
(should(equal '((:tangle . "no")) (should (equal '((:tangle . "no"))
(org-babel-get-header (org-babel-get-header
org-babel-default-header-args :tangle))) org-babel-default-header-args :tangle)))
;; with OTHERS option ;; with OTHERS option
(should(equal org-babel-default-header-args (should (equal org-babel-default-header-args
(org-babel-get-header (org-babel-get-header
org-babel-default-header-args :doesnt-exist 'others))) org-babel-default-header-args :doesnt-exist 'others)))
(should(equal org-babel-default-header-args (should (equal org-babel-default-header-args
(org-babel-get-header (org-babel-get-header
org-babel-default-header-args nil 'others))) org-babel-default-header-args nil 'others)))
(should(equal (should (null
'((:session . "none") (:results . "replace") (:exports . "code") (assoc :noweb
(:cache . "no") (:hlines . "no") (:tangle . "no")) (org-babel-get-header
(org-babel-get-header org-babel-default-header-args :noweb 'others)))))
org-babel-default-header-args :noweb 'others))))
(ert-deftest test-org-babel/default-inline-header-args () (ert-deftest test-org-babel/default-inline-header-args ()
(should(equal (should(equal
@ -226,7 +196,7 @@
(ert-deftest test-org-babel/sha1-hash () (ert-deftest test-org-babel/sha1-hash ()
(org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718" (org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
(org-babel-next-src-block 2) (org-babel-next-src-block 2)
(should(string= "7374bf4f8a18dfcb6f365f93d15f1a0ef42db745" (should(string= "ede4619c95e0467fd23d40d81385445281a483ee"
(org-babel-sha1-hash))))) (org-babel-sha1-hash)))))
(ert-deftest test-org-babel/parse-header-args () (ert-deftest test-org-babel/parse-header-args ()