Browse Source

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.
Nicolas Goaziou 5 years ago
parent
commit
1cac3127c2
5 changed files with 151 additions and 197 deletions
  1. 1 1
      lisp/ob-exp.el
  2. 1 1
      lisp/ox.el
  3. 119 160
      testing/lisp/test-ob-exp.el
  4. 17 23
      testing/lisp/test-ob-lob.el
  5. 13 12
      testing/org-test.el

+ 1 - 1
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

+ 1 - 1
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))))
 
 

+ 119 - 160
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)))
-		'("<code>:noweb</code> header argument expansion"
-		  "message" "expanded1"
-		  "message" "expanded2"
-		  "noweb-1-yes-start"
-		  "message" "expanded1"
-		  "noweb-no-start"
-		  "&lt;&lt;noweb-example1&gt;&gt;"
-		  "noweb-2-yes-start"
-		  "message" "expanded2"
-		  "noweb-tangle-start"
-		  "&lt;&lt;noweb-example1&gt;&gt;"
-		  "&lt;&lt;noweb-example2&gt;&gt;"))))))
+  (should
+   (equal
+    '("(message \"expanded1\")" "(message \"expanded2\")" ";; noweb-1-yes-start
+  (message \"expanded1\")
+  (message \"expanded1\")" ";; noweb-no-start
+  <<noweb-example1>>" ";; noweb-2-yes-start
+  (message \"expanded2\")
+  (message \"expanded2\")" ";; noweb-tangle-start
+<<noweb-example1>>
+<<noweb-example2>>")
+    (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)))
-		'("<code>:noweb</code> header argument expansion using :exports results"
-		  "expanded1"
-		  "expanded2"
-		  "expanded1"
-		  "noweb-no-start"
-		  "&lt;&lt;noweb-example1&gt;&gt;"
-		  "expanded2"
-		  "&lt;&lt;noweb-example1&gt;&gt;"
-		  "&lt;&lt;noweb-example2&gt;&gt;"))))))
+  (should
+   (equal
+    '(";; noweb-no-start
+  <<noweb-example1>>" "<<noweb-example1>>
+<<noweb-example2>>")
+    (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 <pre></pre> and <table></table>
-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 &ndash; exports both test"
-		   "<pre"
-		   "defun" "pascals-triangle"
-		   "if""list""list""let*""prev-triangle"
-		   "pascals-triangle""prev-row""car""reverse""prev-triangle"
-		   "append""prev-triangle""list""map""list"
-		   "append""prev-row""append""prev-row""pascals-triangle"
-		   "</pre>"
-		   "<table""<tbody>"
-		   "<tr>"">1<""</tr>"
-		   "<tr>"">1<"">1<""</tr>"
-		   "<tr>"">1<"">2<"">1<""</tr>"
-		   "<tr>"">1<"">3<"">3<"">1<""</tr>"
-		   "<tr>"">1<"">4<"">6<"">4<"">1<""</tr>"
-		   "<tr>"">1<"">5<"">10<"">10<"">5<"">1<""</tr>"
-		   "</tbody>""</table>"))))))
+    (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"
-		  "<ul class=\"org-ul\">"
-		  "<li>""a""</li>"
-		  "<li>""b""</li>"
-		  "<li>""c""</li>"
-		  "</ul>"
-		  "<pre"
-		  "\"code block results\""
-		  "</pre>"
-		  "<pre class=\"example\">"
-		  "code block results"
-		  "</pre>"))))))
+  (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
+    "<<noweb-no-export-and-exports-both-1>>"
+    (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</\\(code\\|tt\\)> of"
-		    "end of a line. <\\(code\\|tt\\)>2</\\(code\\|tt\\)>"
-		    "<\\(code\\|tt\\)>3</\\(code\\|tt\\)> 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 "<<strip-export-1>>") 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 "<<strip-export-1>>") 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 <<bar>>)
 #+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)))))
 

+ 17 - 23
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 <code> tags
-	(should (re-search-forward "2" nil t))
-	(should (re-search-forward (regexp-quote "</code>") (point-at-eol) t))
-	(should (re-search-backward (regexp-quote "<code>") (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 "</code>") (point-at-eol) t))
-	(should (re-search-backward (regexp-quote "<code>") (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)
 

+ 13 - 12
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)