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