;;;; org-test.el --- Tests for Org-mode ;; 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 ;; David Maus, Brunswick, Germany, dmaus ictsoc de ;; Released under the GNU General Public License version 3 ;; see: http://www.gnu.org/licenses/gpl-3.0.html ;; Definition of `special-mode' copied from Emacs23's simple.el to be ;; provide a testing environment for Emacs22. ;;;; Comments: ;; Interactive testing for Org mode. ;; 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. ;;; Test Development ;; For test development purposes a number of navigation and test ;; function construction routines are available as a git submodule ;; (jump.el) ;; Install with... ;; $ git submodule init ;; $ git submodule update ;;;; Code: (let ((org-test-dir (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))) (let ((org-lisp-dir (expand-file-name (concat org-test-dir "../lisp")))) (unless (featurep 'org) (setq load-path (cons org-lisp-dir load-path)) (org-babel-do-load-languages 'org-babel-load-languages '((sh . t))))) (let* ((load-path (cons (expand-file-name "ert" org-test-dir) (cons (expand-file-name "jump" org-test-dir) load-path)))) (require 'cl) (when (= emacs-major-version 22) (defvar special-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "q" 'quit-window) (define-key map " " 'scroll-up) (define-key map "\C-?" 'scroll-down) (define-key map "?" 'describe-mode) (define-key map "h" 'describe-mode) (define-key map ">" 'end-of-buffer) (define-key map "<" 'beginning-of-buffer) (define-key map "g" 'revert-buffer) (define-key map "z" 'kill-this-buffer) map)) (put 'special-mode 'mode-class 'special) (define-derived-mode special-mode nil "Special" "Parent major mode from which special major modes should inherit." (setq buffer-read-only t))) (require 'ert) (require 'ert-x) (when (file-exists-p (expand-file-name "jump/jump.el" org-test-dir)) (require 'jump) (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.") (defconst org-test-default-directory-name "testing" "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)))) (defconst org-base-dir (expand-file-name ".." org-test-dir)) (defconst org-test-example-dir (expand-file-name "examples" org-test-dir)) (defconst org-test-file (expand-file-name "normal.org" org-test-example-dir)) (defconst org-test-no-heading-file (expand-file-name "no-heading.org" org-test-example-dir)) (defconst org-test-link-in-heading-file (expand-file-name "link-in-heading.org" org-test-dir)) ;;; Functions for writing tests (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.") (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 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)) `(let* ((my-file (or ,file org-test-file)) (visited-p (get-file-buffer my-file)) to-be-removed) (save-window-excursion (save-match-data (find-file my-file) (setq to-be-removed (current-buffer)) (goto-char (point-min)) (condition-case nil (progn (outline-next-visible-heading 1) (org-show-subtree) (org-show-block-all)) (error nil)) (save-restriction ,@body))) (unless visited-p (kill-buffer to-be-removed)))) (defmacro org-test-at-marker (file marker &rest body) "Run body after placing the point at MARKER in FILE. Note the uuidgen command-line command can be useful for generating unique markers for insertion as anchors into org files." (declare (indent 2)) `(org-test-in-example-file ,file (goto-char (point-min)) (re-search-forward (regexp-quote ,marker)) ,@body)) (defmacro org-test-with-temp-text (text &rest body) "Run body in a temporary buffer with Org-mode as the active mode holding TEXT. If the string \"\" appears in TEXT then remove it and place the point there before running BODY." (declare (indent 1)) `(with-temp-buffer (org-mode) ,(let ((point (string-match (regexp-quote "") text))) (if point `(progn (insert `(replace-match "" nil nil text)) (goto-char ,(match-beginning 0))) `(progn (insert ,text) (goto-char (point-min))))) ,@body)) ;;; Navigation Functions (when (featurep 'jump) (defjump org-test-jump (("lisp/\\1.el" . "testing/lisp/test-\\1.el") ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el") ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el") ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el") ("testing/lisp/test-\\1.el" . "lisp/\\1.el") ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el") ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el") ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el")) (concat org-base-dir "/") "Jump between org-mode files and their tests." (lambda (path) (let* ((full-path (expand-file-name path org-base-dir)) (file-name (file-name-nondirectory path)) (name (file-name-sans-extension file-name))) (find-file full-path) (insert ";;; " file-name "\n\n" ";; Copyright (c) " (nth 5 (decode-time (current-time))) " " user-full-name "\n" ";; Authors: " user-full-name "\n\n" ";; Released under the GNU General Public License version 3\n" ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n" ";;;; Comments:\n\n" ";; Template test file for Org-mode tests\n\n" " \n" ";;; Code:\n" "(let ((load-path (cons (expand-file-name\n" " \"..\" (file-name-directory\n" " (or load-file-name buffer-file-name)))\n" " load-path)))\n" " (require 'org-test)\n" " (require 'org-test-ob-consts))\n\n" " \n" ";;; Tests\n" "(ert-deftest " name "/example-test ()\n" " \"Just an example to get you started.\"\n" " (should t)\n" " (should-not nil)\n" " (should-error (error \"errr...\")))\n\n\n" "(provide '" name ")\n\n" ";;; " file-name " ends here\n") full-path)) (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))) (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump) ;;; Miscellaneous helper functions (defun org-test-strip-text-props (s) "Return S without any text properties." (let ((noprop (copy-sequence s))) (set-text-properties 0 (length noprop) nil noprop) noprop)) (defun org-test-string-exact-match (regex string &optional start) "case sensative string-match" (let ((case-fold-search nil) (case-replace nil)) (if(and (equal regex "") (not(equal string ""))) nil (if (equal 0 (string-match regex string start)) t nil)))) ;;; Load and Run tests (defun org-test-load () "Load up the org-mode test suite." (interactive) (flet ((rload (base) (mapc (lambda (path) (if (file-directory-p path) (rload path) (load-file path))) (directory-files base 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$")))) (rload (expand-file-name "lisp" org-test-dir)) (rload (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir))))) (defun org-test-current-defun () "Test the current function." (interactive) (ert (which-function))) (defun org-test-current-file () "Run all tests for current file." (interactive) (ert (concat "test-" (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) "/"))) (defun org-test-touch-all-examples () (dolist (file (directory-files org-test-example-dir 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")) (find-file file))) (defun org-test-run-batch-tests () "Run all defined tests matching \"\\(org\\|ob\\)\". Load all test files first." (interactive) (org-test-touch-all-examples) (org-test-load) (ert-run-tests-batch-and-exit "\\(org\\|ob\\)")) (defun org-test-run-all-tests () "Run all defined tests matching \"\\(org\\|ob\\)\". Load all test files first." (interactive) (org-test-touch-all-examples) (org-test-load) (ert "\\(org\\|ob\\)")) (provide 'org-test) ;;; org-test.el ends here