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