From 1cac3127c2f810e83fcc1203f1dd2b15250a687e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 28 Jan 2013 00:09:58 +0100 Subject: [PATCH] Fix tests related to export * lisp/ob-exp.el (org-babel-exp-process-buffer): Renamed from `org-export-blocks-preprocess'. * lisp/ox.el (org-export-execute-babel-code): Apply previous renaming. * testing/org-test.el (org-test-at-id): Make sure the function returns the value of the last form in its body. * testing/lisp/test-ob-exp.el: Fix tests. * testing/lisp/test-ob-lob.el: Fix tests. --- lisp/ob-exp.el | 2 +- lisp/ox.el | 2 +- testing/lisp/test-ob-exp.el | 279 +++++++++++++++--------------------- testing/lisp/test-ob-lob.el | 40 +++--- testing/org-test.el | 25 ++-- 5 files changed, 151 insertions(+), 197 deletions(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 8e3889c26..0d98690bd 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -241,7 +241,7 @@ this template." (insert rep))))))))))))) (defvar org-src-preserve-indentation) ; From org-src.el -(defun org-export-blocks-preprocess () +(defun org-babel-exp-process-buffer () "Execute all blocks in visible part of buffer." (interactive) (save-window-excursion diff --git a/lisp/ox.el b/lisp/ox.el index 41e191745..267630d01 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3142,7 +3142,7 @@ file should have." ;; properly resolved. (let ((reference (org-export-copy-buffer))) (unwind-protect (let ((org-current-export-file reference)) - (org-export-blocks-preprocess)) + (org-babel-exp-process-buffer)) (kill-buffer reference)))) diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index bcf17b740..abfe2309b 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -23,14 +23,29 @@ ;; Template test file for Org-mode tests ;;; Code: + +(defmacro org-test-with-expanded-babel-code (&rest body) + "Execute BODY while in a buffer with all Babel code evaluated. +Current buffer is a copy of the original buffer." + `(let ((string (buffer-string)) + (buf (current-buffer))) + (with-temp-buffer + (org-mode) + (insert string) + (let ((org-current-export-file buf)) + (org-babel-exp-process-buffer)) + (goto-char (point-min)) + (progn ,@body)))) + (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers () - "Testing export without any headlines in the org-mode file." + "Testing export without any headlines in the Org mode file." + (require 'ox-html) (let ((html-file (concat (file-name-sans-extension org-test-no-heading-file) ".html"))) (when (file-exists-p html-file) (delete-file html-file)) (org-test-in-example-file org-test-no-heading-file - ;; export the file to html - (org-export-as-html nil)) + ;; Export the file to HTML. + (org-export-to-file 'html html-file)) ;; should create a .html file (should (file-exists-p html-file)) ;; should not create a file with "::" appended to it's name @@ -39,18 +54,17 @@ (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-file () "Testing export from buffers which are not visiting any file." - (when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*")) - (should-not (get-buffer "*Org HTML Export*")) - ;; export the file to HTML in a temporary buffer - (org-test-in-example-file nil (org-export-as-html-to-buffer nil)) - ;; should create a .html buffer - (should (buffer-live-p (get-buffer "*Org HTML Export*"))) - ;; should contain the content of the buffer - (save-excursion - (set-buffer (get-buffer "*Org HTML Export*")) - (should (string-match (regexp-quote org-test-file-ob-anchor) - (buffer-string)))) - (when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*"))) + (require 'ox-html) + (let ((name (generate-new-buffer-name "*Org HTML Export*"))) + (org-test-in-example-file nil + (org-export-to-buffer 'html name nil nil t)) + ;; Should create a HTML buffer. + (should (buffer-live-p (get-buffer name))) + ;; Should contain the content of the buffer. + (with-current-buffer (get-buffer name) + (should (string-match (regexp-quote org-test-file-ob-anchor) + (buffer-string)))) + (when (get-buffer name) (kill-buffer name)))) (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers2 () "Testing export without any headlines in the org-mode file." @@ -60,7 +74,7 @@ (when (file-exists-p html-file) (delete-file html-file)) (org-test-in-example-file org-test-link-in-heading-file ;; export the file to html - (org-export-as-html nil)) + (org-export-to-file 'html html-file)) ;; should create a .html file (should (file-exists-p html-file)) ;; should not create a file with "::" appended to it's name @@ -72,134 +86,72 @@ - yes expand on both export and tangle - no expand on neither export or tangle - tangle expand on only tangle not export" - (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7" - (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '(":noweb header argument expansion" - "message" "expanded1" - "message" "expanded2" - "noweb-1-yes-start" - "message" "expanded1" - "noweb-no-start" - "<<noweb-example1>>" - "noweb-2-yes-start" - "message" "expanded2" - "noweb-tangle-start" - "<<noweb-example1>>" - "<<noweb-example2>>")))))) + (should + (equal + '("(message \"expanded1\")" "(message \"expanded2\")" ";; noweb-1-yes-start + (message \"expanded1\") + (message \"expanded1\")" ";; noweb-no-start + <>" ";; noweb-2-yes-start + (message \"expanded2\") + (message \"expanded2\")" ";; noweb-tangle-start +<> +<>") + (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7" + (org-narrow-to-subtree) + (org-element-map + (org-test-with-expanded-babel-code (org-element-parse-buffer)) + 'src-block + (lambda (src) (org-trim (org-element-property :value src)))))))) (ert-deftest ob-exp/noweb-on-export-with-exports-results () "Noweb header arguments export correctly using :exports results. - yes expand on both export and tangle - no expand on neither export or tangle - tangle expand on only tangle not export" - (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d" - (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '(":noweb header argument expansion using :exports results" - "expanded1" - "expanded2" - "expanded1" - "noweb-no-start" - "<<noweb-example1>>" - "expanded2" - "<<noweb-example1>>" - "<<noweb-example2>>")))))) + (should + (equal + '(";; noweb-no-start + <>" "<> +<>") + (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d" + (org-narrow-to-subtree) + (org-element-map + (org-test-with-expanded-babel-code (org-element-parse-buffer)) + 'src-block + (lambda (src) (org-trim (org-element-property :value src)))))))) (ert-deftest ob-exp/exports-both () - "Test the :exports both header argument. -The code block should create both 
 and 

-elements in the final html."
+  "Test the \":exports both\" header argument.
+The code block evaluation should create both a code block and
+a table."
   (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
     (org-narrow-to-subtree)
-    (let ((exported-html
-	   (org-export-as-html nil nil 'string 'body-only))
-	  (test-point 0))
-      (org-test-with-temp-text-in-file
-	  exported-html
-
-	;; check following ouput exists and in order
-	(mapcar (lambda (x)
-		  (should (< test-point
-			     (re-search-forward
-			      x
-			      nil t)))
-		  (setq test-point (point)))
-		'( "Pascal's Triangle – exports both test"
-		   ""
-		   ""
-		   """>1<"""
-		   """>1<"">1<"""
-		   """>1<"">2<"">1<"""
-		   """>1<"">3<"">3<"">1<"""
-		   """>1<"">4<"">6<"">4<"">1<"""
-		   """>1<"">5<"">10<"">10<"">5<"">1<"""
-		   """"))))))
+    (let ((tree (org-test-with-expanded-babel-code (org-element-parse-buffer))))
+      (should (and (org-element-map tree 'src-block 'identity)
+		   (org-element-map tree 'table 'identity))))))
 
 (ert-deftest ob-exp/mixed-blocks-with-exports-both ()
-  (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
-    (org-narrow-to-subtree)
-    (let ((exported-html
-	   (org-export-as-html nil nil 'string  'body-only))
-	  (test-point 0))
-      (org-test-with-temp-text-in-file
-	  exported-html
-	;; check following ouput exists and in order
-	(mapcar (lambda (x)
-		  (should (< test-point (re-search-forward x nil t)))
-		  (setq test-point (point)))
-		'("mixed blocks with exports both"
-		  "
    "
-		  "
  • ""a""
    • "
-		  "
  • ""b""
    • "
-		  "
  • ""c""
    • "
-		  "
"
-		  ""
-		  "
"
-		  "code block results"
-		  "
"))))))
+  (should
+   (equal
+    '(property-drawer plain-list src-block fixed-width src-block plain-list)
+    (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
+      (org-narrow-to-subtree)
+      (mapcar 'org-element-type
+	      (org-element-map
+		  (org-test-with-expanded-babel-code
+		   (org-element-parse-buffer 'greater-element))
+		  'section 'org-element-contents nil t))))))
 
 (ert-deftest ob-exp/export-with-name ()
-  (let ((org-babel-exp-code-template
-	 "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
-    (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
-      (org-narrow-to-subtree)
-      (let ((ascii (org-export-as-ascii nil nil 'string 'body-only)))
-	(should (string-match "qux" ascii))))))
+  (should
+   (string-match
+    "=qux="
+    (let ((org-babel-exp-code-template
+	   "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
+      (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
+	(org-narrow-to-subtree)
+	(org-test-with-expanded-babel-code
+	 (buffer-string)))))))
 
 (ert-deftest ob-exp/export-with-header-argument ()
   (let ((org-babel-exp-code-template
@@ -211,50 +163,58 @@ elements in the final html."
 #+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
     (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
       (org-narrow-to-subtree)
-      (let ((ascii (org-export-as-ascii nil nil 'string 'body-only)))
-	(should (string-match "baz" ascii))
-	(should (string-match "replace" ascii))))))
+      (org-test-with-expanded-babel-code
+       (should (string-match "baz" (buffer-string)))
+       (should (string-match "replace" (buffer-string)))))))
 
 (ert-deftest ob-exp/noweb-no-export-and-exports-both ()
-  (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
-    (org-narrow-to-subtree)
-    (let ((html (org-export-as-html nil nil 'string 'body-only)))
-      (should (string-match (regexp-quote "noweb-no-export-and-exports-both-1")
-			    html)))))
+  (should
+   (string-match
+    "<>"
+    (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
+      (org-narrow-to-subtree)
+      (org-test-with-expanded-babel-code
+       (org-element-map (org-element-parse-buffer) 'src-block
+	 (lambda (src-block) (org-element-property :value src-block))
+	 nil t))))))
 
 (ert-deftest ob-exp/evaluate-all-executables-in-order ()
-  (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
-    (org-narrow-to-subtree)
-    (let (*evaluation-collector*)
-      (org-export-as-ascii nil nil 'string)
-      (should (equal '(5 4 3 2 1) *evaluation-collector*)))))
+  (should
+   (equal '(5 4 3 2 1)
+	  (let (*evaluation-collector*)
+	    (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
+	      (org-narrow-to-subtree)
+	      (buffer-string)
+	      (fboundp 'org-export-execute-babel-code)
+	      (org-test-with-expanded-babel-code *evaluation-collector*))))))
 
 (ert-deftest ob-exp/exports-inline ()
-  (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
-    (org-narrow-to-subtree)
-    (let ((html (org-export-as-html nil nil 'string 'body-only)))
-      (dolist (rx '("middle <\\(code\\|tt\\)>1 of"
-		    "end of a line. <\\(code\\|tt\\)>2"
-		    "<\\(code\\|tt\\)>3 Here is one"))
-	(should (string-match rx html))))))
+  (should
+   (string-match
+    (regexp-quote "Here is one in the middle =1= of a line.
+Here is one at the end of a line. =2=
+=3= Here is one at the beginning of a line.")
+    (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
+      (org-narrow-to-subtree)
+      (org-test-with-expanded-babel-code (buffer-string))))))
 
 (ert-deftest ob-exp/export-call-line-information ()
   (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
     (org-narrow-to-subtree)
-    (let* ((org-babel-exp-call-line-template "\n: call: %line special-token")
-	   (html (org-export-as-html nil nil 'string t)))
-      (should (string-match "double" html))
-      (should (string-match "16" html))
-      (should (string-match "special-token" html)))))
+    (let ((org-babel-exp-call-line-template "\n: call: %line special-token"))
+      (org-test-with-expanded-babel-code
+       (should (string-match "double" (buffer-string)))
+       (should (string-match "16" (buffer-string)))
+       (should (string-match "special-token" (buffer-string)))))))
 
 (ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
   (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
     (org-narrow-to-subtree)
     (org-babel-next-src-block 2)
     (should (= 110 (org-babel-execute-src-block)))
-    (let ((ascii (org-export-as-ascii nil nil 'string t)))
-      (should-not (string-match (regexp-quote "<>") ascii))
-      (should-not (string-match (regexp-quote "i=\"10\"") ascii)))))
+    (let ((result (org-test-with-expanded-babel-code (buffer-string))))
+      (should-not (string-match (regexp-quote "<>") result))
+      (should-not (string-match (regexp-quote "i=\"10\"") result)))))
 
 (ert-deftest ob-exp/export-from-a-temp-buffer ()
   :expected-result :failed
@@ -276,8 +236,7 @@ elements in the final html."
   (list foo <>)
 #+END_SRC
 "
-    (let* ((org-current-export-file (current-buffer))
-	   (ascii (org-export-as-ascii nil nil 'string)))
+    (let* ((ascii (org-export-as 'ascii)))
       (should (string-match (regexp-quote (format nil "%S" '(:foo :bar)))
 			    ascii)))))
 
diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el
index 6483e226c..10a839947 100644
--- a/testing/lisp/test-ob-lob.el
+++ b/testing/lisp/test-ob-lob.el
@@ -80,37 +80,31 @@
   "Test the export of a variety of library babel call lines."
   (org-test-at-id "72ddeed3-2d17-4c7f-8192-a575d535d3fc"
     (org-narrow-to-subtree)
-    (let ((html (org-export-as-html nil nil 'string 'body-only)))
-      ;; check the location of each exported number
+    (let ((buf (current-buffer))
+	  (string (buffer-string)))
       (with-temp-buffer
-	(insert html) (goto-char (point-min))
-	;; 0 should be on a line by itself
-	(should (re-search-forward "0" nil t))
-	(should (string= "0" (buffer-substring (point-at-bol) (point-at-eol))))
-	;; 2 should be in  tags
-	(should (re-search-forward "2" nil t))
-	(should (re-search-forward (regexp-quote "") (point-at-eol) t))
-	(should (re-search-backward (regexp-quote "") (point-at-bol) t))
-	;; 4 should not be exported
-	(should (not (re-search-forward "4" nil t)))
-	;; 6 should also be inline
-	(should (re-search-forward "6" nil t))
-	(should (re-search-forward (regexp-quote "") (point-at-eol) t))
-	(should (re-search-backward (regexp-quote "") (point-at-bol) t))
-	;; 8 should not be quoted
-	(should (re-search-forward "8" nil t))
-	(should (not (= ?= (char-after (point)))))
-	(should (not (= ?= (char-before (- (point) 1)))))
-	;; 10 should export
-	(should (re-search-forward "10" nil t))))))
+	(org-mode)
+	(insert string)
+	(let ((org-current-export-file buf))
+	  (org-babel-exp-process-buffer))
+	(message (buffer-string))
+	(should (re-search-forward "^: 0" nil t))
+	(should (re-search-forward "call =2= stuck" nil t))
+	(should (re-search-forward
+		 "exported =call_double(it=2)= because" nil t))
+	(should (re-search-forward "^=6= because" nil t))
+	(should (re-search-forward "results 8 should" nil t))
+	(should (re-search-forward "following 2\\*5==10= should" nil t))))))
 
 (ert-deftest test-ob-lob/do-not-eval-lob-lines-in-example-blocks-on-export ()
+  (require 'ox)
   (org-test-with-temp-text-in-file "
 for export
 #+begin_example
 #+call: rubbish()
 #+end_example"
-    (org-export-as-html nil)))
+    (should (progn (org-export-execute-babel-code) t))))
+
 
 (provide 'test-ob-lob)
 
diff --git a/testing/org-test.el b/testing/org-test.el
index 15344a795..dbf0d2809 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -136,18 +136,19 @@ currently executed.")
 	  (id-file (car id-location))
 	  (visited-p (get-file-buffer id-file))
 	  to-be-removed)
-     (save-window-excursion
-       (save-match-data
-	 (org-id-goto ,id)
-	 (setq to-be-removed (current-buffer))
-	 (condition-case nil
-	     (progn
-	       (org-show-subtree)
-	       (org-show-block-all))
-	   (error nil))
-	 (save-restriction ,@body)))
-     (unless visited-p
-       (kill-buffer to-be-removed))))
+     (unwind-protect
+	 (save-window-excursion
+	   (save-match-data
+	     (org-id-goto ,id)
+	     (setq to-be-removed (current-buffer))
+	     (condition-case nil
+		 (progn
+		   (org-show-subtree)
+		   (org-show-block-all))
+	       (error nil))
+	     (save-restriction ,@body)))
+       (unless (or visited-p (not to-be-removed))
+	 (kill-buffer to-be-removed)))))
 (def-edebug-spec org-test-at-id (form body))
 
 (defmacro org-test-in-example-file (file &rest body)