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