new testing macro for in-file execution with temp text
[org-mode.git] / testing / org-test.el
1 ;;;; org-test.el --- Tests for Org-mode
2
3 ;; Copyright (c) 2010 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
150 (defmacro org-test-in-example-file (file &rest body)
151   "Execute body in the Org-mode example file."
152   (declare (indent 1))
153   `(let* ((my-file (or ,file org-test-file))
154           (visited-p (get-file-buffer my-file))
155           to-be-removed)
156      (save-window-excursion
157        (save-match-data
158          (find-file my-file)
159          (unless (eq major-mode 'org-mode)
160            (org-mode))
161          (setq to-be-removed (current-buffer))
162          (goto-char (point-min))
163          (condition-case nil
164              (progn
165                (outline-next-visible-heading 1)
166                (org-show-subtree)
167                (org-show-block-all))
168            (error nil))
169          (save-restriction ,@body)))
170      (unless visited-p
171        (kill-buffer to-be-removed))))
172
173 (defmacro org-test-at-marker (file marker &rest body)
174   "Run body after placing the point at MARKER in FILE.
175 Note the uuidgen command-line command can be useful for
176 generating unique markers for insertion as anchors into org
177 files."
178   (declare (indent 2))
179   `(org-test-in-example-file ,file
180      (goto-char (point-min))
181      (re-search-forward (regexp-quote ,marker))
182      ,@body))
183 (def-edebug-spec org-test-at-marker (form form body))
184
185 (defmacro org-test-with-temp-text (text &rest body)
186   "Run body in a temporary buffer with Org-mode as the active
187 mode holding TEXT.  If the string \"<point>\" appears in TEXT
188 then remove it and place the point there before running BODY,
189 otherwise place the point at the beginning of the inserted text."
190   (declare (indent 1))
191   (let ((inside-text (if (stringp text) text (eval text))))
192     `(with-temp-buffer
193        (org-mode)
194        ,(let ((point (string-match (regexp-quote "<point>") inside-text)))
195           (if point
196               `(progn (insert `(replace-match "" nil nil inside-text))
197                       (goto-char ,(match-beginning 0)))
198             `(progn (insert ,inside-text)
199                     (goto-char (point-min)))))
200        ,@body)))
201 (def-edebug-spec org-test-with-temp-text (form body))
202
203 (defmacro org-test-with-temp-text-in-file (text &rest body)
204   "Run body in a temporary file buffer with Org-mode as the active mode."
205   (declare (indent 1))
206   (let ((file (make-temp-file "org-test"))
207         (inside-text (if (stringp text) text (eval text)))
208         (results (gensym)))
209     `(let ((kill-buffer-query-functions nil) ,results)
210        (with-temp-file ,file (insert ,inside-text))
211        (find-file ,file)
212        (org-mode)
213        (setq ,results ,@body)
214        (save-buffer) (kill-buffer)
215        (delete-file ,file)
216        ,results)))
217 (def-edebug-spec org-test-with-temp-text-in-file (form body))
218
219 \f
220 ;;; Navigation Functions
221 (when (featurep 'jump)
222   (defjump org-test-jump
223     (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
224      ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
225      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
226      ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
227      ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
228      ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
229      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
230      ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
231     (concat org-base-dir "/")
232     "Jump between org-mode files and their tests."
233     (lambda (path)
234       (let* ((full-path (expand-file-name path org-base-dir))
235              (file-name (file-name-nondirectory path))
236              (name (file-name-sans-extension file-name)))
237         (find-file full-path)
238         (insert
239          ";;; " file-name "\n\n"
240          ";; Copyright (c) " (nth 5 (decode-time (current-time)))
241          " " user-full-name "\n"
242          ";; Authors: " user-full-name "\n\n"
243          ";; Released under the GNU General Public License version 3\n"
244          ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
245          ";;;; Comments:\n\n"
246          ";; Template test file for Org-mode tests\n\n"
247          "\f\n"
248          ";;; Code:\n"
249          "(let ((load-path (cons (expand-file-name\n"
250          "                      \"..\" (file-name-directory\n"
251          "                            (or load-file-name buffer-file-name)))\n"
252          "                     load-path)))\n"
253          "  (require 'org-test)\n"
254          "  (require 'org-test-ob-consts))\n\n"
255          "\f\n"
256          ";;; Tests\n"
257          "(ert-deftest " name "/example-test ()\n"
258          "  \"Just an example to get you started.\"\n"
259          "  (should t)\n"
260          "  (should-not nil)\n"
261          "  (should-error (error \"errr...\")))\n\n\n"
262          "(provide '" name ")\n\n"
263          ";;; " file-name " ends here\n") full-path))
264     (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
265
266 (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
267
268 \f
269 ;;; Miscellaneous helper functions
270 (defun org-test-strip-text-props (s)
271   "Return S without any text properties."
272   (let ((noprop (copy-sequence s)))
273     (set-text-properties 0 (length noprop) nil noprop)
274     noprop))
275 \f
276
277 (defun org-test-string-exact-match (regex string &optional start)
278   "case sensative string-match"
279   (let ((case-fold-search nil)
280         (case-replace nil))
281     (if(and (equal regex "")
282             (not(equal string "")))
283         nil
284       (if (equal 0 (string-match regex string start))
285           t
286         nil))))
287
288 ;;; Load and Run tests
289 (defun org-test-load ()
290   "Load up the org-mode test suite."
291   (interactive)
292   (flet ((rld (base)
293               ;; Recursively load all files, if files throw errors
294               ;; then silently ignore the error and continue to the
295               ;; next file.  This allows files to error out if
296               ;; required executables aren't available.
297               (mapc
298                (lambda (path)
299                  (if (file-directory-p path)
300                      (rld path)
301                    (condition-case err
302                        (when (string-match "^[A-Za-z].*\\.el$"
303                                          (file-name-nondirectory path))
304                          (load-file path))
305                      (missing-test-dependency
306                       (let ((name (intern
307                                    (concat "org-missing-dependency/"
308                                            (file-name-nondirectory
309                                             (file-name-sans-extension path))))))
310                         (eval `(ert-deftest ,name ()
311                                  :expected-result :failed (should nil))))))))
312                (directory-files base 'full
313                                 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
314     (rld (expand-file-name "lisp" org-test-dir))
315     (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
316
317 (defun org-test-current-defun ()
318   "Test the current function."
319   (interactive)
320   (ert (which-function)))
321
322 (defun org-test-current-file ()
323   "Run all tests for current file."
324   (interactive)
325   (ert (concat "test-"
326                (file-name-sans-extension
327                 (file-name-nondirectory (buffer-file-name)))
328                "/")))
329
330 (defun org-test-touch-all-examples ()
331   (dolist (file (directory-files
332                  org-test-example-dir 'full
333                  "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
334     (find-file file)))
335
336 (defun org-test-update-id-locations ()
337   (org-id-update-id-locations
338    (directory-files
339     org-test-example-dir 'full
340     "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")))
341
342 (defun org-test-run-batch-tests ()
343   "Run all defined tests matching \"\\(org\\|ob\\)\".
344 Load all test files first."
345   (interactive)
346   (let ((org-id-track-globally t)
347         (org-id-locations-file
348          (convert-standard-filename
349           (expand-file-name
350            "testing/.test-org-id-locations"
351            org-base-dir))))
352     (org-test-touch-all-examples)
353     (org-test-update-id-locations)
354     (org-test-load)
355     (ert-run-tests-batch-and-exit "\\(org\\|ob\\)")))
356
357 (defun org-test-run-all-tests ()
358   "Run all defined tests matching \"\\(org\\|ob\\)\".
359 Load all test files first."
360   (interactive)
361   (org-test-touch-all-examples)
362   (org-test-load)
363   (ert "\\(org\\|ob\\)"))
364
365 (provide 'org-test)
366
367 ;;; org-test.el ends here