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