testing/org-test.el

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