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