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