testing/org-test.el

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