testing/org-test.el

   1 ;;;; org-test.el --- Tests for Org-mode
   2
   3 ;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
   4 ;; Authors:
   5 ;;     Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
   6 ;;     Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
   7
   8 ;; Released under the GNU General Public License version 3
   9 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
  10
  11 ;;;; Comments:
  12
  13 ;; Interactive testing for Org mode.
  14
  15 ;; The heart of all this is the commands `org-test-current-defun'.  If
  16 ;; called while in a `defun' all ert tests with names matching the
  17 ;; name of the function are run.
  18
  19 ;;; Prerequisites:
  20
  21 ;; ERT and jump.el are both included as git submodules, install with
  22 ;;   $ git submodule init
  23 ;;   $ git submodule update
  24
  25 \f
  26 ;;;; Code:
  27 (let* ((org-test-dir (expand-file-name
  28                       (file-name-directory
  29                        (or load-file-name buffer-file-name))))
  30        (load-path (cons
  31                    (expand-file-name "ert" org-test-dir)
  32                    (cons
  33                     (expand-file-name "jump" org-test-dir)
  34                     load-path))))
  35   (require 'ert-batch)
  36   (require 'ert)
  37   (require 'ert-exp)
  38   (require 'ert-exp-t)
  39   (require 'ert-run)
  40   (require 'ert-ui)
  41   (require 'jump)
  42   (require 'which-func)
  43   (require 'org))
  44
  45 (defconst org-test-default-test-file-name "tests.el"
  46   "For each defun a separate file with tests may be defined.
  47 tests.el is the fallback or default if you like.")
  48
  49 (defconst org-test-default-directory-name "testing"
  50   "Basename or the directory where the tests live.
  51 org-test searches this directory up the directory tree.")
  52
  53 (defconst org-test-dir
  54   (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
  55
  56 (defconst org-base-dir
  57   (expand-file-name ".." org-test-dir))
  58
  59 (defconst org-test-example-dir
  60   (expand-file-name "examples" org-test-dir))
  61
  62 (defconst org-test-file
  63   (expand-file-name "normal.org" org-test-example-dir))
  64
  65 (defconst org-test-no-heading-file
  66   (expand-file-name "no-heading.org" org-test-example-dir))
  67
  68 (defconst org-test-link-in-heading-file
  69   (expand-file-name "link-in-heading.org" org-test-dir))
  70
  71 \f
  72 ;;; Functions for writing tests
  73 (defun org-test-buffer (&optional file)
  74   "TODO:  Setup and return a buffer to work with.
  75 If file is non-nil insert it's contents in there.")
  76
  77 (defun org-test-compare-with-file (&optional file)
  78   "TODO:  Compare the contents of the test buffer with FILE.
  79 If file is not given, search for a file named after the test
  80 currently executed.")
  81
  82 (defmacro org-test-at-id (id &rest body)
  83   "Run body after placing the point in the headline identified by ID."
  84   (declare (indent 1))
  85   `(let* ((id-location (org-id-find ,id))
  86           (id-file (car id-location))
  87           (visited-p (get-file-buffer id-file))
  88           to-be-removed)
  89      (save-window-excursion
  90        (save-match-data
  91          (org-id-goto ,id)
  92          (setq to-be-removed (current-buffer))
  93          (condition-case nil
  94              (progn
  95                (org-show-subtree)
  96                (org-show-block-all))
  97            (error nil))
  98          (save-restriction ,@body)))
  99      (unless visited-p
 100        (kill-buffer to-be-removed))))
 101
 102 (defmacro org-test-in-example-file (file &rest body)
 103   "Execute body in the Org-mode example file."
 104   (declare (indent 1))
 105   `(let* ((my-file (or ,file org-test-file))
 106           (visited-p (get-file-buffer my-file))
 107           to-be-removed)
 108      (save-window-excursion
 109        (save-match-data
 110          (find-file my-file)
 111          (setq to-be-removed (current-buffer))
 112          (goto-char (point-min))
 113          (condition-case nil
 114              (progn
 115                (outline-next-visible-heading 1)
 116                (org-show-subtree)
 117                (org-show-block-all))
 118            (error nil))
 119          (save-restriction ,@body)))
 120      (unless visited-p
 121        (kill-buffer to-be-removed))))
 122
 123 (defmacro org-test-at-marker (file marker &rest body)
 124   "Run body after placing the point at MARKER in FILE.
 125 Note the uuidgen command-line command can be useful for
 126 generating unique markers for insertion as anchors into org
 127 files."
 128   (declare (indent 2))
 129   `(org-test-in-example-file ,file
 130      (goto-char (point-min))
 131      (re-search-forward (regexp-quote ,marker))
 132      ,@body))
 133
 134 \f
 135 ;;; Navigation Functions
 136 (defjump org-test-jump
 137   (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
 138    ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
 139    ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
 140    ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
 141    ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
 142    ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
 143    ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
 144    ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
 145   (concat org-base-dir "/")
 146   "Jump between org-mode files and their tests."
 147   (lambda (path)
 148     (let* ((full-path (expand-file-name path org-base-dir))
 149           (file-name (file-name-nondirectory path))
 150           (name (file-name-sans-extension file-name)))
 151       (find-file full-path)
 152       (insert
 153        ";;; " file-name "\n\n"
 154        ";; Copyright (c) " (nth 5 (decode-time (current-time)))
 155        " " user-full-name "\n"
 156        ";; Authors: " user-full-name "\n\n"
 157        ";; Released under the GNU General Public License version 3\n"
 158        ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
 159        ";;;; Comments:\n\n"
 160        ";; Template test file for Org-mode tests\n\n"
 161        "\f\n"
 162        ";;; Code:\n"
 163        "(let ((load-path (cons (expand-file-name\n"
 164        "                        \"..\" (file-name-directory\n"
 165        "                              (or load-file-name buffer-file-name)))\n"
 166        "                       load-path)))\n"
 167        "  (require 'org-test)\n"
 168        "  (require 'org-test-ob-consts))\n\n"
 169        "\f\n"
 170        ";;; Tests\n"
 171        "(ert-deftest " name "/example-test ()\n"
 172        "  \"Just an example to get you started.\"\n"
 173        "  (should t)\n"
 174        "  (should-not nil)\n"
 175        "  (should-error (error \"errr...\")))\n\n\n"
 176        "(provide '" name ")\n\n"
 177        ";;; " file-name " ends here\n") full-path))
 178   (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))
 179
 180 (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
 181
 182 \f
 183 ;;; Miscellaneous helper functions
 184 (defun org-test-strip-text-props (s)
 185   "Return S without any text properties."
 186   (let ((noprop (copy-sequence s)))
 187     (set-text-properties 0 (length noprop) nil noprop)
 188     noprop))
 189 \f
 190 ;;; Load and Run tests
 191 (defun org-test-load ()
 192   "Load up the org-mode test suite."
 193   (interactive)
 194   (flet ((rload (base)
 195                 (mapc
 196                  (lambda (path)
 197                    (if (file-directory-p path) (rload path) (load-file path)))
 198                  (directory-files base 'full
 199                                   "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el"))))
 200     (rload (expand-file-name "lisp" org-test-dir))
 201     (rload (expand-file-name "lisp"
 202                              (expand-file-name "contrib" org-test-dir)))))
 203
 204 (defun org-test-current-defun ()
 205   "Test the current function."
 206   (interactive)
 207   (ert (which-function)))
 208
 209 (defun org-test-current-file ()
 210   "Run all tests for current file."
 211   (interactive)
 212   (ert (concat "test-"
 213                (file-name-sans-extension
 214                 (file-name-nondirectory (buffer-file-name)))
 215                "/")))
 216
 217 (defun org-test-run-all-tests ()
 218   "Run all defined tests matching \"\\(org\\|ob\\)\".
 219 Load all test files first."
 220   (interactive)
 221   (org-test-load)
 222   (ert "\\(org\\|ob\\)"))
 223
 224 (provide 'org-test)
 225
 226 ;;; org-test.el ends here