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