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-for-executable (exe)
 106   "Throw an error if EXE is not available.
 107 This can be used at the top of code-block-language specific test
 108 files to avoid loading the file on systems without the
 109 executable."
 110   (unless (reduce
 111            (lambda (acc dir)
 112              (or acc (file-exists-p (expand-file-name exe dir))))
 113            exec-path :initial-value nil)
 114     (throw 'missing-test-dependency exe)))
 115
 116 (defun org-test-buffer (&optional file)
 117   "TODO:  Setup and return a buffer to work with.
 118 If file is non-nil insert it's contents in there.")
 119
 120 (defun org-test-compare-with-file (&optional file)
 121   "TODO:  Compare the contents of the test buffer with FILE.
 122 If file is not given, search for a file named after the test
 123 currently executed.")
 124
 125 (defmacro org-test-at-id (id &rest body)
 126   "Run body after placing the point in the headline identified by ID."
 127   (declare (indent 1))
 128   `(let* ((id-location (org-id-find ,id))
 129           (id-file (car id-location))
 130           (visited-p (get-file-buffer id-file))
 131           to-be-removed)
 132      (save-window-excursion
 133        (save-match-data
 134          (org-id-goto ,id)
 135          (setq to-be-removed (current-buffer))
 136          (condition-case nil
 137              (progn
 138                (org-show-subtree)
 139                (org-show-block-all))
 140            (error nil))
 141          (save-restriction ,@body)))
 142      (unless visited-p
 143        (kill-buffer to-be-removed))))
 144
 145 (defmacro org-test-in-example-file (file &rest body)
 146   "Execute body in the Org-mode example file."
 147   (declare (indent 1))
 148   `(let* ((my-file (or ,file org-test-file))
 149           (visited-p (get-file-buffer my-file))
 150           to-be-removed)
 151      (save-window-excursion
 152        (save-match-data
 153          (find-file my-file)
 154          (unless (eq major-mode 'org-mode)
 155            (org-mode))
 156          (setq to-be-removed (current-buffer))
 157          (goto-char (point-min))
 158          (condition-case nil
 159              (progn
 160                (outline-next-visible-heading 1)
 161                (org-show-subtree)
 162                (org-show-block-all))
 163            (error nil))
 164          (save-restriction ,@body)))
 165      (unless visited-p
 166        (kill-buffer to-be-removed))))
 167
 168 (defmacro org-test-at-marker (file marker &rest body)
 169   "Run body after placing the point at MARKER in FILE.
 170 Note the uuidgen command-line command can be useful for
 171 generating unique markers for insertion as anchors into org
 172 files."
 173   (declare (indent 2))
 174   `(org-test-in-example-file ,file
 175      (goto-char (point-min))
 176      (re-search-forward (regexp-quote ,marker))
 177      ,@body))
 178
 179 (defmacro org-test-with-temp-text (text &rest body)
 180   "Run body in a temporary buffer with Org-mode as the active
 181 mode holding TEXT.  If the string \"<point>\" appears in TEXT
 182 then remove it and place the point there before running BODY,
 183 otherwise place the point at the beginning of the inserted text."
 184   (declare (indent 1))
 185   (let ((inside-text (if (stringp text) text (eval text))))
 186     `(with-temp-buffer
 187        (org-mode)
 188        ,(let ((point (string-match (regexp-quote "<point>") inside-text)))
 189           (if point
 190               `(progn (insert `(replace-match "" nil nil inside-text))
 191                       (goto-char ,(match-beginning 0)))
 192             `(progn (insert ,inside-text)
 193                     (goto-char (point-min)))))
 194        ,@body)))
 195
 196 \f
 197 ;;; Navigation Functions
 198 (when (featurep 'jump)
 199   (defjump org-test-jump
 200     (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
 201      ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
 202      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
 203      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
 204      ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
 205      ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
 206      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
 207      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
 208     (concat org-base-dir "/")
 209     "Jump between org-mode files and their tests."
 210     (lambda (path)
 211       (let* ((full-path (expand-file-name path org-base-dir))
 212              (file-name (file-name-nondirectory path))
 213              (name (file-name-sans-extension file-name)))
 214         (find-file full-path)
 215         (insert
 216          ";;; " file-name "\n\n"
 217          ";; Copyright (c) " (nth 5 (decode-time (current-time)))
 218          " " user-full-name "\n"
 219          ";; Authors: " user-full-name "\n\n"
 220          ";; Released under the GNU General Public License version 3\n"
 221          ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
 222          ";;;; Comments:\n\n"
 223          ";; Template test file for Org-mode tests\n\n"
 224          "\f\n"
 225          ";;; Code:\n"
 226          "(let ((load-path (cons (expand-file-name\n"
 227          "                      \"..\" (file-name-directory\n"
 228          "                            (or load-file-name buffer-file-name)))\n"
 229          "                     load-path)))\n"
 230          "  (require 'org-test)\n"
 231          "  (require 'org-test-ob-consts))\n\n"
 232          "\f\n"
 233          ";;; Tests\n"
 234          "(ert-deftest " name "/example-test ()\n"
 235          "  \"Just an example to get you started.\"\n"
 236          "  (should t)\n"
 237          "  (should-not nil)\n"
 238          "  (should-error (error \"errr...\")))\n\n\n"
 239          "(provide '" name ")\n\n"
 240          ";;; " file-name " ends here\n") full-path))
 241     (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
 242
 243 (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
 244
 245 \f
 246 ;;; Miscellaneous helper functions
 247 (defun org-test-strip-text-props (s)
 248   "Return S without any text properties."
 249   (let ((noprop (copy-sequence s)))
 250     (set-text-properties 0 (length noprop) nil noprop)
 251     noprop))
 252 \f
 253
 254 (defun org-test-string-exact-match (regex string &optional start)
 255   "case sensative string-match"
 256   (let ((case-fold-search nil)
 257         (case-replace nil))
 258     (if(and (equal regex "")
 259             (not(equal string "")))
 260         nil
 261       (if (equal 0 (string-match regex string start))
 262           t
 263         nil))))
 264
 265 ;;; Load and Run tests
 266 (defun org-test-load ()
 267   "Load up the org-mode test suite."
 268   (interactive)
 269   (flet ((rld (base)
 270               ;; Recursively load all files, if files throw errors
 271               ;; then silently ignore the error and continue to the
 272               ;; next file.  This allows files to error out if
 273               ;; required executables aren't available.
 274               (mapc
 275                (lambda (path)
 276                  (if (file-directory-p path)
 277                    (rld path)
 278                    (catch 'missing-test-dependency
 279                      (load-file path))))
 280                (directory-files base 'full
 281                                 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
 282     (rld (expand-file-name "lisp" org-test-dir))
 283     (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
 284
 285 (defun org-test-current-defun ()
 286   "Test the current function."
 287   (interactive)
 288   (ert (which-function)))
 289
 290 (defun org-test-current-file ()
 291   "Run all tests for current file."
 292   (interactive)
 293   (ert (concat "test-"
 294                (file-name-sans-extension
 295                 (file-name-nondirectory (buffer-file-name)))
 296                "/")))
 297
 298 (defun org-test-touch-all-examples ()
 299   (dolist (file (directory-files
 300                  org-test-example-dir 'full
 301                  "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
 302     (find-file file)))
 303
 304 (defun org-test-run-batch-tests ()
 305   "Run all defined tests matching \"\\(org\\|ob\\)\".
 306 Load all test files first."
 307   (interactive)
 308   (org-test-touch-all-examples)
 309   (org-test-load)
 310   (ert-run-tests-batch-and-exit "\\(org\\|ob\\)"))
 311
 312 (defun org-test-run-all-tests ()
 313   "Run all defined tests matching \"\\(org\\|ob\\)\".
 314 Load all test files first."
 315   (interactive)
 316   (org-test-touch-all-examples)
 317   (org-test-load)
 318   (ert "\\(org\\|ob\\)"))
 319
 320 (provide 'org-test)
 321
 322 ;;; org-test.el ends here