Merge branch 'maint'
[org-mode/org-tableheadings.git] / testing / org-test.el
blobbcd00026d0cbf8247a24ba95c6ae2c54505d1110
1 ;;;; org-test.el --- Tests for Org-mode
3 ;; Copyright (c) 2010-2014 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
9 ;; Released under the GNU General Public License version 3
10 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
12 ;; Definition of `special-mode' copied from Emacs23's simple.el to be
13 ;; provide a testing environment for Emacs22.
15 ;;;; Comments:
17 ;; Interactive testing for Org mode.
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.
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
32 ;;;; Code:
34 ;;; Ob constants
36 (defconst org-test-file-ob-anchor
37 "94839181-184f-4ff4-a72f-94214df6f5ba")
39 (defconst org-test-link-in-heading-file-ob-anchor
40 "a8b1d111-eca8-49f0-8930-56d4f0875155")
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"))))
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))))
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))
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)))))
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.")
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.")
97 (defconst org-test-dir
98 (expand-file-name (file-name-directory (or load-file-name buffer-file-name))))
100 (defconst org-base-dir
101 (expand-file-name ".." org-test-dir))
103 (defconst org-test-example-dir
104 (expand-file-name "examples" org-test-dir))
106 (defconst org-test-file
107 (expand-file-name "normal.org" org-test-example-dir))
109 (defconst org-test-no-heading-file
110 (expand-file-name "no-heading.org" org-test-example-dir))
112 (defconst org-test-link-in-heading-file
113 (expand-file-name "link-in-heading.org" org-test-dir))
115 (defconst org-id-locations-file
116 (expand-file-name ".test-org-id-locations" org-test-dir))
119 ;;; Functions for writing tests
120 (put 'missing-test-dependency
121 'error-conditions
122 '(error missing-test-dependency))
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))))
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.")
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.")
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))
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))
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))
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 (with-temp-buffer
210 (org-mode)
211 (let ((point (string-match "<point>" inside-text)))
212 (if point
213 (progn
214 (insert (replace-match "" nil nil inside-text))
215 (goto-char (1+ (match-beginning 0))))
216 (insert inside-text)
217 (goto-char (point-min))))
218 ,@body)))
219 (def-edebug-spec org-test-with-temp-text (form body))
221 (defmacro org-test-with-temp-text-in-file (text &rest body)
222 "Run body in a temporary file buffer with Org-mode as the active mode."
223 (declare (indent 1))
224 (let ((results (gensym)))
225 `(let ((file (make-temp-file "org-test"))
226 (kill-buffer-query-functions nil)
227 (inside-text (if (stringp ,text) ,text (eval ,text)))
228 ,results)
229 (with-temp-file file (insert inside-text))
230 (find-file file)
231 (org-mode)
232 (setq ,results (progn ,@body))
233 (save-buffer) (kill-buffer (current-buffer))
234 (delete-file file)
235 ,results)))
236 (def-edebug-spec org-test-with-temp-text-in-file (form body))
238 (defun org-test-table-target-expect (target &optional expect laps
239 &rest tblfm)
240 "For all TBLFM: Apply the formula to TARGET, compare EXPECT with result.
241 Either LAPS and TBLFM are nil and the table will only be aligned
242 or LAPS is the count of recalculations that should be made on
243 each TBLFM. To save ERT run time keep LAPS as low as possible to
244 get the table stable. Anyhow, if LAPS is 'iterate then iterate,
245 but this will run one recalculation longer. When EXPECT is nil
246 it will be set to TARGET.
248 When running a test interactively in ERT is not enough and you
249 need to examine the target table with e. g. the Org formula
250 debugger or an Emacs Lisp debugger (e. g. with point in a data
251 field and calling the instrumented `org-table-eval-formula') then
252 copy and paste the table with formula from the ERT results buffer
253 or temporarily substitute the `org-test-with-temp-text' of this
254 function with `org-test-with-temp-text-in-file'. Also consider
255 setting `pp-escape-newlines' to nil manually."
256 (require 'pp)
257 (let ((back pp-escape-newlines) (current-tblfm))
258 (unless tblfm
259 (should-not laps)
260 (push "" tblfm)) ; Dummy formula.
261 (unless expect (setq expect target))
262 (while (setq current-tblfm (pop tblfm))
263 (org-test-with-temp-text (concat target current-tblfm)
264 ;; Search the last of possibly several tables, let the ERT
265 ;; test fail if not found.
266 (goto-char (point-max))
267 (while (not (org-at-table-p))
268 (should (eq 0 (forward-line -1))))
269 (when laps
270 (if (and (symbolp laps) (eq laps 'iterate))
271 (should (org-table-recalculate 'iterate t))
272 (should (integerp laps))
273 (should (< 0 laps))
274 (let ((cnt laps))
275 (while (< 0 cnt)
276 (should (org-table-recalculate 'all t))
277 (setq cnt (1- cnt))))))
278 (org-table-align)
279 (setq pp-escape-newlines nil)
280 ;; Declutter the ERT results buffer by giving only variables
281 ;; and not directly the forms to `should'.
282 (let ((expect (concat expect current-tblfm))
283 (result (buffer-substring-no-properties
284 (point-min) (point-max))))
285 (should (equal expect result)))
286 ;; If `should' passed then set back `pp-escape-newlines' here,
287 ;; else leave it nil as a side effect to see the failed table
288 ;; on multiple lines in the ERT results buffer.
289 (setq pp-escape-newlines back)))))
292 ;;; Navigation Functions
293 (when (featurep 'jump)
294 (defjump org-test-jump
295 (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
296 ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
297 ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
298 ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el"))
299 (concat org-base-dir "/")
300 "Jump between org-mode files and their tests."
301 (lambda (path)
302 (let* ((full-path (expand-file-name path org-base-dir))
303 (file-name (file-name-nondirectory path))
304 (name (file-name-sans-extension file-name)))
305 (find-file full-path)
306 (insert
307 ";;; " file-name "\n\n"
308 ";; Copyright (c) " (nth 5 (decode-time (current-time)))
309 " " user-full-name "\n"
310 ";; Authors: " user-full-name "\n\n"
311 ";; Released under the GNU General Public License version 3\n"
312 ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
313 ";;;; Comments:\n\n"
314 ";; Template test file for Org-mode tests\n\n"
315 "\f\n"
316 ";;; Code:\n"
317 "(let ((load-path (cons (expand-file-name\n"
318 " \"..\" (file-name-directory\n"
319 " (or load-file-name buffer-file-name)))\n"
320 " load-path)))\n"
321 " (require 'org-test)\n\n"
322 "\f\n"
323 ";;; Tests\n"
324 "(ert-deftest " name "/example-test ()\n"
325 " \"Just an example to get you started.\"\n"
326 " (should t)\n"
327 " (should-not nil)\n"
328 " (should-error (error \"errr...\")))\n\n\n"
329 "(provide '" name ")\n\n"
330 ";;; " file-name " ends here\n") full-path))
331 (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
333 (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)
336 ;;; Miscellaneous helper functions
337 (defun org-test-strip-text-props (s)
338 "Return S without any text properties."
339 (let ((noprop (copy-sequence s)))
340 (set-text-properties 0 (length noprop) nil noprop)
341 noprop))
344 (defun org-test-string-exact-match (regex string &optional start)
345 "case sensative string-match"
346 (let ((case-fold-search nil)
347 (case-replace nil))
348 (if(and (equal regex "")
349 (not(equal string "")))
351 (if (equal 0 (string-match regex string start))
353 nil))))
355 ;;; Load and Run tests
356 (defun org-test-load ()
357 "Load up the org-mode test suite."
358 (interactive)
359 (flet ((rld (base)
360 ;; Recursively load all files, if files throw errors
361 ;; then silently ignore the error and continue to the
362 ;; next file. This allows files to error out if
363 ;; required executables aren't available.
364 (mapc
365 (lambda (path)
366 (if (file-directory-p path)
367 (rld path)
368 (condition-case err
369 (when (string-match "^[A-Za-z].*\\.el$"
370 (file-name-nondirectory path))
371 (load-file path))
372 (missing-test-dependency
373 (let ((name (intern
374 (concat "org-missing-dependency/"
375 (file-name-nondirectory
376 (file-name-sans-extension path))))))
377 (eval `(ert-deftest ,name ()
378 :expected-result :failed (should nil))))))))
379 (directory-files base 'full
380 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
381 (rld (expand-file-name "lisp" org-test-dir))))
383 (defun org-test-current-defun ()
384 "Test the current function."
385 (interactive)
386 (ert (which-function)))
388 (defun org-test-current-file ()
389 "Run all tests for current file."
390 (interactive)
391 (ert (concat "test-"
392 (file-name-sans-extension
393 (file-name-nondirectory (buffer-file-name)))
394 "/")))
396 (defvar org-test-buffers nil
397 "Hold buffers open for running Org-mode tests.")
399 (defun org-test-touch-all-examples ()
400 (dolist (file (directory-files
401 org-test-example-dir 'full
402 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
403 (unless (get-file-buffer file)
404 (add-to-list 'org-test-buffers (find-file file)))))
406 (defun org-test-kill-all-examples ()
407 (while org-test-buffers
408 (let ((b (pop org-test-buffers)))
409 (when (buffer-live-p b) (kill-buffer b)))))
411 (defun org-test-update-id-locations ()
412 (org-id-update-id-locations
413 (directory-files
414 org-test-example-dir 'full
415 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")))
417 (defun org-test-run-batch-tests (&optional org-test-selector)
418 "Run all tests matching an optional regex which defaults to \"\\(org\\|ob\\)\".
419 Load all test files first."
420 (interactive)
421 (let ((org-id-track-globally t)
422 (org-test-selector
423 (if org-test-selector org-test-selector "\\(org\\|ob\\)"))
424 org-confirm-babel-evaluate org-startup-folded vc-handled-backends)
425 (org-test-touch-all-examples)
426 (org-test-update-id-locations)
427 (org-test-load)
428 (message "selected tests: %s" org-test-selector)
429 (ert-run-tests-batch-and-exit org-test-selector)))
431 (defun org-test-run-all-tests ()
432 "Run all defined tests matching \"\\(org\\|ob\\)\".
433 Load all test files first."
434 (interactive)
435 (org-test-touch-all-examples)
436 (org-test-update-id-locations)
437 (org-test-load)
438 (ert "\\(org\\|ob\\)")
439 (org-test-kill-all-examples))
441 (provide 'org-test)
443 ;;; org-test.el ends here