added tangle tests exercising new desired tangling behavior

testing/examples/babel.org

@@ -0,0 +1,29 @@
+#+Title: a collection of examples for Babel tests
+
+* =:noweb= header argument expansion
+  :PROPERTIES:
+  :ID:       eb1f6498-5bd9-45e0-9c56-50717053e7b7
+  :END:
+
+#+source: noweb-example
+#+begin_src emacs-lisp
+  (message "expanded")
+#+end_src
+
+#+begin_src emacs-lisp :noweb yes
+  ;; noweb-yes-start
+  <<noweb-example>>
+  ;; noweb-yes-end
+#+end_src
+
+#+begin_src emacs-lisp :noweb no
+  ;; noweb-no-start
+  <<noweb-example>>
+  ;; noweb-no-end
+#+end_src
+
+#+begin_src emacs-lisp :noweb tangle
+  ;; noweb-tangle-start
+  <<noweb-example>>
+  ;; noweb-tangle-end
+#+end_src

testing/lisp/test-ob-exp.el

@@ -65,6 +65,25 @@
     (should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
     (when (file-exists-p html-file) (delete-file html-file))))
 
+(ert-deftest ob-exp/noweb-on-export ()
+  "Noweb header arguments export correctly.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (let (html)
+    (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
+      (org-narrow-to-subtree)
+      (setq html (org-export-as-html nil nil nil 'string)))
+    (flet ((exp-p (arg)
+		  (and
+		   (string-match
+		    (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+		    html)
+		   (string-match "expanded" (match-string 1 html)))))
+      (should (exp-p "yes"))
+      (should-not (exp-p "no"))
+      (should-not (exp-p "tangle")))))
+
 (provide 'test-ob-exp)
 
 ;;; test-ob-exp.el ends here

testing/lisp/test-ob-tangle.el

@@ -0,0 +1,48 @@
+;;; test-ob-tangle.el
+
+;; Copyright (c) 2010 Eric Schulte
+;; Authors: Eric Schulte
+
+;; Released under the GNU General Public License version 3
+;; see: http://www.gnu.org/licenses/gpl-3.0.html
+
+;;;; Comments:
+
+;; Template test file for Org-mode tests
+
+
+;;; Code:
+(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))
+
+
+;;; Tests
+(ert-deftest ob-tangle/noweb-on-tangle ()
+  "Noweb header arguments tangle correctly.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (let ((target-file (make-temp-file "ob-tangle-test-")))
+    (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
+      (org-narrow-to-subtree)
+      (org-babel-tangle target-file))
+    (let ((tang (with-temp-buffer
+		  (insert-file-contents target-file)
+		  (buffer-string))))
+      (flet ((exp-p (arg)
+		    (and
+		     (string-match
+		      (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+		      tang)
+		     (string-match "expanded" (match-string 1 tang)))))
+	(should (exp-p "yes"))
+	(should-not (exp-p "no"))
+	(should (exp-p "tangle"))))))
+
+(provide 'test-ob-tangle)
+
+;;; test-ob-tangle.el ends here

testing/org-test.el

@@ -79,6 +79,26 @@ If file is non-nil insert it's contents in there.")
 If file is not given, search for a file named after the test
 currently executed.")
 
+(defmacro org-test-at-id (id &rest body)
+  "Run body after placing the point in the headline identified by ID."
+  (declare (indent 1))
+  `(let* ((id-location (org-id-find ,id))
+	  (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))))
+
 (defmacro org-test-in-example-file (file &rest body)
   "Execute body in the Org-mode example file."
   (declare (indent 1))
@@ -96,7 +116,7 @@ currently executed.")
 	       (org-show-subtree)
 	       (org-show-block-all))
 	   (error nil))
-	 ,@body))
+	 (save-restriction ,@body)))
      (unless visited-p
        (kill-buffer to-be-removed))))
 
@@ -179,11 +199,11 @@ files."
   (ert (car (which-function))))
 
 (defun org-test-run-all-tests ()
-  "Run all defined tests matching \"^org\".
+  "Run all defined tests matching \"\\(org\\|ob\\)\".
 Load all test files first."
   (interactive)
   (org-test-load)
-  (ert "org"))
+  (ert "\\(org\\|ob\\)"))
 
 (provide 'org-test)