merge ert-testing and schulte-testing, temporarily removing navigation functions

testing/example-file.org

@@ -0,0 +1,18 @@
+#+TITLE: Example file
+#+OPTIONS: num:nil ^:nil
+#+STARTUP: hideblocks
+
+This is an example file for use by the Org-mode tests.
+
+* top
+** code block
+   :PROPERTIES:
+   :tangle:   yes
+   :CUSTOM_ID: code-block-section
+   :END:
+Here are a couple of code blocks.
+
+#+begin_src emacs-lisp :tangle no
+  ;; 94839181-184f-4ff4-a72f-94214df6f5ba
+  (message "I am code")
+#+end_src

testing/lisp/test-ob.el

@@ -0,0 +1,29 @@
+;;; test-ob.el --- tests for ob.el
+(require 'org-test)
+
+(defmacro test-ob-in-code-block (marker &rest body)
+  (declare (indent 1))
+  `(in-org-example-file
+     (goto-char (point-min))
+     (re-search-forward (regexp-quote ,marker))
+     ,@body))
+
+(ert-deftest test-org-babel-get-src-block-info-language ()
+  (test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
+    (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 ()
+  (test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
+    (let ((info (org-babel-get-src-block-info)))
+      (should (string-match (regexp-quote "94839181-184f-4ff4-a72f-94214df6f5ba")
+			    (nth 1 info))))))
+
+(ert-deftest test-org-babel-get-src-block-info-tangle ()
+  (test-ob-in-code-block "94839181-184f-4ff4-a72f-94214df6f5ba"
+    (let ((info (org-babel-get-src-block-info)))
+      (should (string= "no" (cdr (assoc :tangle (nth 2 info))))))))
+
+(provide 'test-ob)
+
+;;; test-ob ends here

testing/org-test.el

@@ -1,8 +1,9 @@
 ;;;; org-test.el --- Tests for Org-mode
 
-;; Copyright (c) 2010 Sebastian Rose, Hannover, Germany
+;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
 ;; Authors:
 ;;     Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
+;;     Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
@@ -11,42 +12,28 @@
 
 ;; Interactive testing for Org mode.
 
-;; The heart of all this is the commands
-;; `org-test-test-current-defun'.  If called while in an emacs-lisp
-;; file, org-test first searches for a directory testing/tests/NAME/,
-;; where name is the basename of the lisp file you're in.  This
-;; directory is then searched for a file named like the defun the
-;; point is in.  If that failes, a file named 'tests.el' is searched
-;; in this directory.  The file found is loaded and
-;; `org-test-run-tests' is called with the prefix "^NAME-OF-DEFUN".
-
-;; The second usefull function is `org-test-test-buffer-file'.  This
-;; function searches the same way as `org-test-test-current-defun'
-;; does, but only for the tests.el file.  All tests in that file with
-;; the prefix "^BUFFER-FILE-NAME" with the ".el" suffix stripped are
-;; executed.
+;; The heart of all this is the commands `org-test-current-defun'.  If
+;; called while in a `defun' all ert tests with names matching the
+;; name of the function are run.
 
 ;;; Prerequisites:
 
-;; You'll need to download and install ERT to use this stuff.  You can
-;; get ERT like this:
-;;        sh$  git clone http://github.com/ohler/ert.git
-
+;; ERT and jump.el are both installed as git submodules to install
+;;   them run
+;;   $ git submodule init
+;;   $ git submodule update
 
 
 ;;;; Code:
-
 (require 'ert-batch)
 (require 'ert)
 (require 'ert-exp)
 (require 'ert-exp-t)
 (require 'ert-run)
 (require 'ert-ui)
-
+(require 'which-func)
 (require 'org)
 
-
-
 (defconst org-test-default-test-file-name "tests.el"
   "For each defun a separate file with tests may be defined.
 tests.el is the fallback or default if you like.")
@@ -55,271 +42,65 @@ tests.el is the fallback or default if you like.")
   "Basename or the directory where the tests live.
 org-test searches this directory up the directory tree.")
 
+(defconst org-test-dir
+  (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
 
-
-;;; Find tests
-
-(defun org-test-test-directory-for-file (file)
-  "Search up the directory tree for a directory
-called like `org-test-default-directory-name'.
-If that directory is not found, ask the user.
-
-Return the name of the directory that should contain tests for
-FILE regardless of it's existence.
-
-If the directory `org-test-default-directory-name' cannot be
-found up the directory tree, return nil."
-  (let* ((file (file-truename
-		(or file buffer-file-name)))
-	 (orig
-	  (file-name-directory
-	   (expand-file-name (or file buffer-file-name))))
-	 (parent orig)
-	 (child "")
-	 base)
-    (catch 'dir
-      (progn
-	(while (not (string= parent child))
-	  (let ((td (file-name-as-directory
-		     (concat parent
-			     org-test-default-directory-name))))
-	    (when (file-directory-p td)
-	      (setq base parent)
-	      (throw 'dir parent))
-	    (setq child parent)
-	    (setq parent (file-name-as-directory
-			  (file-truename (concat parent ".."))))))
-	(throw 'dir nil)))
-
-    (if base
-	;; For now, rely on the fact, that if base exists, the rest of
-	;; the directory setup is as expected, too.
-	(progn
-	  (file-name-as-directory
-	   (concat
-	    (file-name-as-directory
-	     (file-truename
-	      (concat
-	       (file-name-as-directory
-		(concat base org-test-default-directory-name))
-	       (file-relative-name orig base))))
-	    (file-name-nondirectory file))))
-      ;; TODO:
-      ;; it's up to the user to find the directory for the file he's
-      ;; testing...
-      ;; (setq base (read-directory-name
-      ;;	  "Testdirectory: " orig orig t))
-      nil)))
-
-(defun org-test-test-file-name-for-file (directory file)
-  "Return the name of the file that should contain the tests for FILE.
-FILE might be a path or a base filename.
-Return nil if no file tests for FILE exists."
-  ;; TODO: fall back on a list of all *.el files in this directory.
-  (let ((tf (concat directory
-		    org-test-default-test-file-name)))
-    (if (file-exists-p tf)
-	tf
-      nil)))
-
-(defun org-test-test-file-name-for-defun (directory fun &optional file)
-  "Return the name of the file that might or might not contain tests
-for defun FUN (a string) defined FILE.  Return nil if no file with
-special tests for FUN exists."
-  (let* ((funsym (intern fun))
-         (file (or file
-                   (find-lisp-object-file-name
-                    (intern fun)
-                    (symbol-function (intern fun)))))
-         (tf (concat directory fun ".el")))
-    (if (file-exists-p tf)
-	tf
-      nil)))
-
+(defconst org-test-example-file-name
+  (expand-file-name "example-file.org" org-test-dir))
 
 
-;;; TODO: Test buffers and control files
+;;; Functions for writing tests
 
+;; TODO
 (defun org-test-buffer (&optional file)
   "TODO:  Setup and return a buffer to work with.
 If file is non-nil insert it's contents in there.")
 
+;; TODO
 (defun org-test-compare-with-file (&optional file)
   "TODO:  Compare the contents of the test buffer with FILE.
 If file is not given, search for a file named after the test
 currently executed.")
 
+(defmacro in-org-example-file (&rest body)
+  "Execute body in the Org-mode example file."
+  (declare (indent 0))
+  `(let ((visited-p (get-file-buffer org-test-example-file-name))
+	 to-be-removed)
+     (save-window-excursion
+       (save-match-data
+	 (find-file org-test-example-file-name)
+	 (setq to-be-removed (current-buffer))
+	 (goto-char (point-min))
+	 (outline-next-visible-heading 1)
+	 (org-show-subtree)
+	 (org-show-block-all)
+	 ,@body))
+     (unless visited-p
+       (kill-buffer to-be-removed))))
 
 
-;;; Run tests
-
-(defun org-test-run-tests (&optional selector)
-  "Run all tests matched by SELECTOR.
-SELECTOR defaults to \"^org\".
-See the docstring of `ert-select-tests' for valid selectors.
-Unless `ert', this function runs all tests inside
- (let ((deactivate-mark nil))
-    (save-excursion
-      (save-match-data
-    ...)))."
-  (interactive)
-  (let ((select (or selector "^org"))
-	(deactivate-mark nil))
-    (save-excursion
-      (save-match-data
-	  (ert select)))))
-
-(defun org-test-run-all-tests ()
-  "Run all defined tests matching \"^org\".
-Unlike `org-test-run-tests', load all test files first.
-Uses `org-test-run-tests' to run the actual tests."
-  (interactive)
-  (let* ((org-dir
-	  (file-name-directory
-	   (find-lisp-object-file-name 'org-mode 'function)))
-	 (org-files
-	  (directory-files org-dir nil "\\.el")))
-    (message "Loading all tests....")
-    (mapc
-     (lambda (f)
-       (let* ((dir (org-test-test-directory-for-file f)))
-	 (when (and dir (file-directory-p dir))
-	   (let ((tfs (directory-files dir t "\\.el")))
-	     (mapc (lambda (tf)
-		     (load-file tf))
-		   tfs)))))
-     org-files)
-  (org-test-run-tests)))
-
-
-
-;;; Utility functions:
-
-(defun org-test-which-func ()
-  "Return the name of the current defun."
-  (save-excursion
-    (save-match-data
-      (end-of-line)
-      (beginning-of-defun)
-      (if (looking-at "(defun[[:space:]]+\\([^([:space:]]*\\)[[:space:]]*(")
-	  (match-string-no-properties 1)
-	(error "No defun found around point.")))))
+;;; Load and Run tests
 
-(defun org-test-ensure-buffer-emacs-lisp-p (&optional buffer)
-  "Ensure BUFFER contains an elisp file based on extension.
-If BUFFER is nil, use the current buffer.
-Error if not."
-  (save-excursion
-    (save-match-data
-      ;; Check, if editing an emacs-lisp file
-      (with-current-buffer (or buffer (current-buffer))
-	(unless
-	    (string-match "\\.el$" buffer-file-name)
-	(error "Not an emacs lisp file: %s" buffer-file-name))))))
-
-
-;;; Commands:
-
-(defun org-test-test-current-defun ()
-  "Execute all tests for function at point if tests exist."
+(defun org-load-tests ()
+  "Load up the org-mode test suite."
   (interactive)
-  (ert-delete-all-tests)
-  (let* ((fun (org-test-wich-func))
-	 (dir (org-test-test-directory-for-file buffer-file-name))
-	 (tf (or (org-test-test-file-name-for-defun
-		  dir fun buffer-file-name)
-		 (org-test-test-file-name-for-file dir buffer-file-name))))
-    (if tf
-	(progn
-	  (load-file tf)
-	  (org-test-run-tests
-	   (concat "^" fun)))
-      (error "No test files found for \"%s\"" fun))))
-
-(defun org-test-test-buffer-file (&optional only)
-  "Run all tests for current `buffer-file-name' if tests exist.
-If ONLY is non-nil, use the `org-test-default-test-file-name'
-file only."
-  (interactive "P")
-  (ert-delete-all-tests)
-  (let* ((pref
-	  (concat
-	   "^"
-	   (file-name-sans-extension
-	    (file-name-nondirectory buffer-file-name))))
-	 (dir (org-test-test-directory-for-file buffer-file-name))
-	 (tfs (if only
-		  (list
-		   (org-test-test-file-name-for-file
-		    dir buffer-file-name))
-		(directory-files dir t "\\.el$"))))
-    (if (car tfs)
-	(mapc
-	 (lambda (tf)
-	   (load-file tf)
-	   (org-test-run-tests pref))
-	 tfs)
-      (error "No %s found for \"%s\""
-	     (if only
-		 (format "file \"%s\"" org-test-default-test-file-name)
-	       "test files")
-	     buffer-file-name))))
+  (mapc (lambda (file) (load-file file))
+	(directory-files (expand-file-name "lisp" org-test-dir)
+			 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el")))
 
-(defun org-test-edit-buffer-file-tests (&optional func)
-  "Open the `org-test-default-test-file-name' file for editing.
-If the file (and parent directories) do not yet exist,
-create them."
+(defun org-test-current-defun ()
+  "Test the current function."
   (interactive)
-  (org-test-ensure-buffer-emacs-lisp-p)
-
-  (let ((dir (org-test-test-directory-for-file
-	      buffer-file-name)))
-    (unless dir
-      (error "Directory %s not found. Sorry."
-	     org-test-default-directory-name))
-
-    (let* ((tf     (concat
-		    dir
-		    (if func
-			(concat func ".el")
-			org-test-default-test-file-name)))
-	  (exists  (file-exists-p tf))
-	  (rel     (file-relative-name buffer-file-name dir))
-	  (tprefix (file-name-nondirectory
-		    (file-name-sans-extension buffer-file-name))))
-      (unless (file-directory-p dir)	; FIXME: Ask?
-	(make-directory dir t))
-      (find-file tf)
-      (unless exists
-	(insert
-	 ";;; " (file-name-nondirectory tf) "\n"
-	 ";; Tests for `"
-	 (if func (concat  func "' in `") "")
-	 (replace-regexp-in-string "^\\(?:\\.+/\\)+" "" rel)
-	 "'\n\n"
-	 "\n"
-	 ";;; Code:\n"
-	 "(require 'org-test)\n"
-	 "(unless (fboundp 'org-test-run-all-tests)\n"
-	 "  (error \"%s\" \"org-test.el not loaded.  Giving up.\"))\n"
-	 "\n"
-	 "\n"
-	 ";;; Tests\n"
-	 "(ert-deftest " tprefix "/example-test ()\n"
-	 "  \"Just an example to get you started.\"\n"
-	 "  (should t)\n"
-	 "  (should-not nil)\n"
-	 "  (should-error (error \"errr...\")))\n")))))
+  (ert (car (which-function))))
 
-(defun org-test-edit-current-defuns-tests ()
-  "Open the file with tests related to the current defun.
-If the file (and parent directories) do not yet exist,
-create them."
+(defun org-test-run-all-tests ()
+  "Run all defined tests matching \"^org\".
+Load all test files first."
   (interactive)
-  (org-test-ensure-buffer-emacs-lisp-p)
-  (org-test-edit-buffer-file-tests
-   (org-test-which-func)))
-
+  (org-load-tests)
+  (ert "^org"))
 
 (provide 'org-test)
+
 ;;; org-test.el ends here