testing/org-test.el

   1 ;;;; org-test.el --- Tests for Org-mode
   2
   3 ;; Copyright (c) 2010-2012 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     (require 'org-id)
  43      (org-babel-do-load-languages
  44      'org-babel-load-languages '((sh . t) (org . t))))
  45
  46   (let* ((load-path (cons
  47                      org-test-dir
  48                      (cons
  49                       (expand-file-name "jump" org-test-dir)
  50                       load-path))))
  51     (require 'cl)
  52     (when (= emacs-major-version 22)
  53       (defvar special-mode-map
  54         (let ((map (make-sparse-keymap)))
  55           (suppress-keymap map)
  56           (define-key map "q" 'quit-window)
  57           (define-key map " " 'scroll-up)
  58           (define-key map "\C-?" 'scroll-down)
  59           (define-key map "?" 'describe-mode)
  60           (define-key map "h" 'describe-mode)
  61           (define-key map ">" 'end-of-buffer)
  62           (define-key map "<" 'beginning-of-buffer)
  63           (define-key map "g" 'revert-buffer)
  64           (define-key map "z" 'kill-this-buffer)
  65           map))
  66
  67       (put 'special-mode 'mode-class 'special)
  68       (define-derived-mode special-mode nil "Special"
  69         "Parent major mode from which special major modes should inherit."
  70         (setq buffer-read-only t)))
  71     (require 'ert)
  72     (require 'ert-x)
  73     (when (file-exists-p
  74            (expand-file-name "jump/jump.el" org-test-dir))
  75       (require 'jump)
  76       (require 'which-func))))
  77
  78 (defconst org-test-default-test-file-name "tests.el"
  79   "For each defun a separate file with tests may be defined.
  80 tests.el is the fallback or default if you like.")
  81
  82 (defconst org-test-default-directory-name "testing"
  83   "Basename or the directory where the tests live.
  84 org-test searches this directory up the directory tree.")
  85
  86 (defconst org-test-dir
  87   (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
  88
  89 (defconst org-base-dir
  90   (expand-file-name ".." org-test-dir))
  91
  92 (defconst org-test-example-dir
  93   (expand-file-name "examples" org-test-dir))
  94
  95 (defconst org-test-file
  96   (expand-file-name "normal.org" org-test-example-dir))
  97
  98 (defconst org-test-no-heading-file
  99   (expand-file-name "no-heading.org" org-test-example-dir))
 100
 101 (defconst org-test-link-in-heading-file
 102   (expand-file-name "link-in-heading.org" org-test-dir))
 103
 104 \f
 105 ;;; Functions for writing tests
 106 (put 'missing-test-dependency
 107      'error-conditions
 108      '(error missing-test-dependency))
 109
 110 (defun org-test-for-executable (exe)
 111   "Throw an error if EXE is not available.
 112 This can be used at the top of code-block-language specific test
 113 files to avoid loading the file on systems without the
 114 executable."
 115   (unless (reduce
 116            (lambda (acc dir)
 117              (or acc (file-exists-p (expand-file-name exe dir))))
 118            exec-path :initial-value nil)
 119     (signal 'missing-test-dependency (list exe))))
 120
 121 (defun org-test-buffer (&optional file)
 122   "TODO:  Setup and return a buffer to work with.
 123 If file is non-nil insert it's contents in there.")
 124
 125 (defun org-test-compare-with-file (&optional file)
 126   "TODO:  Compare the contents of the test buffer with FILE.
 127 If file is not given, search for a file named after the test
 128 currently executed.")
 129
 130 (defmacro org-test-at-id (id &rest body)
 131   "Run body after placing the point in the headline identified by ID."
 132   (declare (indent 1))
 133   `(let* ((id-location (org-id-find ,id))
 134           (id-file (car id-location))
 135           (visited-p (get-file-buffer id-file))
 136           to-be-removed)
 137      (save-window-excursion
 138        (save-match-data
 139          (org-id-goto ,id)
 140          (setq to-be-removed (current-buffer))
 141          (condition-case nil
 142              (progn
 143                (org-show-subtree)
 144                (org-show-block-all))
 145            (error nil))
 146          (save-restriction ,@body)))
 147      (unless visited-p
 148        (kill-buffer to-be-removed))))
 149 (def-edebug-spec org-test-at-id (form body))
 150
 151 (defmacro org-test-in-example-file (file &rest body)
 152   "Execute body in the Org-mode example file."
 153   (declare (indent 1))
 154   `(let* ((my-file (or ,file org-test-file))
 155           (visited-p (get-file-buffer my-file))
 156           to-be-removed)
 157      (save-window-excursion
 158        (save-match-data
 159          (find-file my-file)
 160          (unless (eq major-mode 'org-mode)
 161            (org-mode))
 162          (setq to-be-removed (current-buffer))
 163          (goto-char (point-min))
 164          (condition-case nil
 165              (progn
 166                (outline-next-visible-heading 1)
 167                (org-show-subtree)
 168                (org-show-block-all))
 169            (error nil))
 170          (save-restriction ,@body)))
 171      (unless visited-p
 172        (kill-buffer to-be-removed))))
 173 (def-edebug-spec org-test-in-example-file (form body))
 174
 175 (defmacro org-test-at-marker (file marker &rest body)
 176   "Run body after placing the point at MARKER in FILE.
 177 Note the uuidgen command-line command can be useful for
 178 generating unique markers for insertion as anchors into org
 179 files."
 180   (declare (indent 2))
 181   `(org-test-in-example-file ,file
 182      (goto-char (point-min))
 183      (re-search-forward (regexp-quote ,marker))
 184      ,@body))
 185 (def-edebug-spec org-test-at-marker (form form body))
 186
 187 (defmacro org-test-with-temp-text (text &rest body)
 188   "Run body in a temporary buffer with Org-mode as the active
 189 mode holding TEXT.  If the string \"<point>\" appears in TEXT
 190 then remove it and place the point there before running BODY,
 191 otherwise place the point at the beginning of the inserted text."
 192   (declare (indent 1))
 193   (let ((inside-text (if (stringp text) text (eval text))))
 194     `(with-temp-buffer
 195        (org-mode)
 196        ,(let ((point (string-match (regexp-quote "<point>") inside-text)))
 197           (if point
 198               `(progn (insert `(replace-match "" nil nil inside-text))
 199                       (goto-char ,(match-beginning 0)))
 200             `(progn (insert ,inside-text)
 201                     (goto-char (point-min)))))
 202        (prog1 ,@body (kill-buffer)))))
 203 (def-edebug-spec org-test-with-temp-text (form body))
 204
 205 (defmacro org-test-with-temp-text-in-file (text &rest body)
 206   "Run body in a temporary file buffer with Org-mode as the active mode."
 207   (declare (indent 1))
 208   (let ((file (make-temp-file "org-test"))
 209         (inside-text (if (stringp text) text (eval text)))
 210         (results (gensym)))
 211     `(let ((kill-buffer-query-functions nil) ,results)
 212        (with-temp-file ,file (insert ,inside-text))
 213        (find-file ,file)
 214        (org-mode)
 215        (setq ,results ,@body)
 216        (save-buffer) (kill-buffer (current-buffer))
 217        (delete-file ,file)
 218        ,results)))
 219 (def-edebug-spec org-test-with-temp-text-in-file (form body))
 220
 221 \f
 222 ;;; Navigation Functions
 223 (when (featurep 'jump)
 224   (defjump org-test-jump
 225     (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
 226      ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
 227      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
 228      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
 229      ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
 230      ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
 231      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
 232      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
 233     (concat org-base-dir "/")
 234     "Jump between org-mode files and their tests."
 235     (lambda (path)
 236       (let* ((full-path (expand-file-name path org-base-dir))
 237              (file-name (file-name-nondirectory path))
 238              (name (file-name-sans-extension file-name)))
 239         (find-file full-path)
 240         (insert
 241          ";;; " file-name "\n\n"
 242          ";; Copyright (c) " (nth 5 (decode-time (current-time)))
 243          " " user-full-name "\n"
 244          ";; Authors: " user-full-name "\n\n"
 245          ";; Released under the GNU General Public License version 3\n"
 246          ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
 247          ";;;; Comments:\n\n"
 248          ";; Template test file for Org-mode tests\n\n"
 249          "\f\n"
 250          ";;; Code:\n"
 251          "(let ((load-path (cons (expand-file-name\n"
 252          "                      \"..\" (file-name-directory\n"
 253          "                            (or load-file-name buffer-file-name)))\n"
 254          "                     load-path)))\n"
 255          "  (require 'org-test)\n"
 256          "  (require 'org-test-ob-consts))\n\n"
 257          "\f\n"
 258          ";;; Tests\n"
 259          "(ert-deftest " name "/example-test ()\n"
 260          "  \"Just an example to get you started.\"\n"
 261          "  (should t)\n"
 262          "  (should-not nil)\n"
 263          "  (should-error (error \"errr...\")))\n\n\n"
 264          "(provide '" name ")\n\n"
 265          ";;; " file-name " ends here\n") full-path))
 266     (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
 267
 268 (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
 269
 270 \f
 271 ;;; Miscellaneous helper functions
 272 (defun org-test-strip-text-props (s)
 273   "Return S without any text properties."
 274   (let ((noprop (copy-sequence s)))
 275     (set-text-properties 0 (length noprop) nil noprop)
 276     noprop))
 277 \f
 278
 279 (defun org-test-string-exact-match (regex string &optional start)
 280   "case sensative string-match"
 281   (let ((case-fold-search nil)
 282         (case-replace nil))
 283     (if(and (equal regex "")
 284             (not(equal string "")))
 285         nil
 286       (if (equal 0 (string-match regex string start))
 287           t
 288         nil))))
 289
 290 ;;; Load and Run tests
 291 (defun org-test-load ()
 292   "Load up the org-mode test suite."
 293   (interactive)
 294   (flet ((rld (base)
 295               ;; Recursively load all files, if files throw errors
 296               ;; then silently ignore the error and continue to the
 297               ;; next file.  This allows files to error out if
 298               ;; required executables aren't available.
 299               (mapc
 300                (lambda (path)
 301                  (if (file-directory-p path)
 302                      (rld path)
 303                    (condition-case err
 304                        (when (string-match "^[A-Za-z].*\\.el$"
 305                                          (file-name-nondirectory path))
 306                          (load-file path))
 307                      (missing-test-dependency
 308                       (let ((name (intern
 309                                    (concat "org-missing-dependency/"
 310                                            (file-name-nondirectory
 311                                             (file-name-sans-extension path))))))
 312                         (eval `(ert-deftest ,name ()
 313                                  :expected-result :failed (should nil))))))))
 314                (directory-files base 'full
 315                                 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
 316     (rld (expand-file-name "lisp" org-test-dir))
 317     (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
 318
 319 (defun org-test-current-defun ()
 320   "Test the current function."
 321   (interactive)
 322   (ert (which-function)))
 323
 324 (defun org-test-current-file ()
 325   "Run all tests for current file."
 326   (interactive)
 327   (ert (concat "test-"
 328                (file-name-sans-extension
 329                 (file-name-nondirectory (buffer-file-name)))
 330                "/")))
 331
 332 (defvar org-test-buffers nil
 333   "Hold buffers open for running Org-mode tests.")
 334
 335 (defun org-test-touch-all-examples ()
 336   (dolist (file (directory-files
 337                  org-test-example-dir 'full
 338                  "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
 339     (unless (get-file-buffer file)
 340       (add-to-list 'org-test-buffers (find-file file)))))
 341
 342 (defun org-test-kill-all-examples ()
 343   (while org-test-buffers
 344     (let ((b (pop org-test-buffers)))
 345       (when (buffer-live-p b) (kill-buffer b)))))
 346
 347 (defun org-test-update-id-locations ()
 348   (org-id-update-id-locations
 349    (directory-files
 350     org-test-example-dir 'full
 351     "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")))
 352
 353 (defun org-test-run-batch-tests ()
 354   "Run all defined tests matching \"\\(org\\|ob\\)\".
 355 Load all test files first."
 356   (interactive)
 357   (let ((org-id-track-globally t)
 358         (org-id-locations-file
 359          (convert-standard-filename
 360           (expand-file-name
 361            "testing/.test-org-id-locations"
 362            org-base-dir))))
 363     (org-test-touch-all-examples)
 364     (org-test-update-id-locations)
 365     (org-test-load)
 366     (ert-run-tests-batch-and-exit "\\(org\\|ob\\)")))
 367
 368 (defun org-test-run-all-tests ()
 369   "Run all defined tests matching \"\\(org\\|ob\\)\".
 370 Load all test files first."
 371   (interactive)
 372   (org-test-touch-all-examples)
 373   (org-test-load)
 374   (ert "\\(org\\|ob\\)")
 375   (org-test-kill-all-examples))
 376
 377 (provide 'org-test)
 378
 379 ;;; org-test.el ends here