1 ;;;; org-test.el --- Tests for Org-mode
3 ;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
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.
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.
24 ;; For test development purposes a number of navigation and test
25 ;; function construction routines are available as a git submodule
28 ;; $ git submodule init
29 ;; $ git submodule update
33 (let* ((org-test-dir (expand-file-name
35 (or load-file-name buffer-file-name
))))
36 (org-lisp-dir (expand-file-name
37 (concat org-test-dir
"../lisp"))))
39 (unless (featurep 'org
)
40 (setq load-path
(cons org-lisp-dir load-path
))
43 (org-babel-do-load-languages
44 'org-babel-load-languages
'((sh . t
) (org . t
))))
46 (let* ((load-path (cons
49 (expand-file-name "jump" org-test-dir
)
52 (when (= emacs-major-version
22)
53 (defvar special-mode-map
54 (let ((map (make-sparse-keymap)))
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
)
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
)))
74 (expand-file-name "jump/jump.el" org-test-dir
))
76 (require 'which-func
))))
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.")
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.")
86 (defconst org-test-dir
87 (expand-file-name (file-name-directory (or load-file-name buffer-file-name
))))
89 (defconst org-base-dir
90 (expand-file-name ".." org-test-dir
))
92 (defconst org-test-example-dir
93 (expand-file-name "examples" org-test-dir
))
95 (defconst org-test-file
96 (expand-file-name "normal.org" org-test-example-dir
))
98 (defconst org-test-no-heading-file
99 (expand-file-name "no-heading.org" org-test-example-dir
))
101 (defconst org-test-link-in-heading-file
102 (expand-file-name "link-in-heading.org" org-test-dir
))
105 ;;; Functions for writing tests
106 (put 'missing-test-dependency
108 '(error missing-test-dependency
))
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
117 (or acc
(file-exists-p (expand-file-name exe dir
))))
118 exec-path
:initial-value nil
)
119 (signal 'missing-test-dependency
(list exe
))))
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.")
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.")
130 (defmacro org-test-at-id
(id &rest body
)
131 "Run body after placing the point in the headline identified by ID."
133 `(let* ((id-location (org-id-find ,id
))
134 (id-file (car id-location
))
135 (visited-p (get-file-buffer id-file
))
137 (save-window-excursion
140 (setq to-be-removed
(current-buffer))
144 (org-show-block-all))
146 (save-restriction ,@body
)))
148 (kill-buffer to-be-removed
))))
150 (defmacro org-test-in-example-file
(file &rest body
)
151 "Execute body in the Org-mode example file."
153 `(let* ((my-file (or ,file org-test-file
))
154 (visited-p (get-file-buffer my-file
))
156 (save-window-excursion
159 (unless (eq major-mode
'org-mode
)
161 (setq to-be-removed
(current-buffer))
162 (goto-char (point-min))
165 (outline-next-visible-heading 1)
167 (org-show-block-all))
169 (save-restriction ,@body
)))
171 (kill-buffer to-be-removed
))))
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
179 `(org-test-in-example-file ,file
180 (goto-char (point-min))
181 (re-search-forward (regexp-quote ,marker
))
184 (defmacro org-test-with-temp-text
(text &rest body
)
185 "Run body in a temporary buffer with Org-mode as the active
186 mode holding TEXT. If the string \"<point>\" appears in TEXT
187 then remove it and place the point there before running BODY,
188 otherwise place the point at the beginning of the inserted text."
190 (let ((inside-text (if (stringp text
) text
(eval text
))))
193 ,(let ((point (string-match (regexp-quote "<point>") inside-text
)))
195 `(progn (insert `(replace-match "" nil nil inside-text
))
196 (goto-char ,(match-beginning 0)))
197 `(progn (insert ,inside-text
)
198 (goto-char (point-min)))))
202 ;;; Navigation Functions
203 (when (featurep 'jump
)
204 (defjump org-test-jump
205 (("lisp/\\1.el" .
"testing/lisp/test-\\1.el")
206 ("lisp/\\1.el" .
"testing/lisp/\\1.el/test.*.el")
207 ("contrib/lisp/\\1.el" .
"testing/contrib/lisp/test-\\1.el")
208 ("contrib/lisp/\\1.el" .
"testing/contrib/lisp/\\1.el/test.*.el")
209 ("testing/lisp/test-\\1.el" .
"lisp/\\1.el")
210 ("testing/lisp/\\1.el" .
"lisp/\\1.el/test.*.el")
211 ("testing/contrib/lisp/test-\\1.el" .
"contrib/lisp/\\1.el")
212 ("testing/contrib/lisp/test-\\1.el" .
"contrib/lisp/\\1.el/test.*.el"))
213 (concat org-base-dir
"/")
214 "Jump between org-mode files and their tests."
216 (let* ((full-path (expand-file-name path org-base-dir
))
217 (file-name (file-name-nondirectory path
))
218 (name (file-name-sans-extension file-name
)))
219 (find-file full-path
)
221 ";;; " file-name
"\n\n"
222 ";; Copyright (c) " (nth 5 (decode-time (current-time)))
223 " " user-full-name
"\n"
224 ";; Authors: " user-full-name
"\n\n"
225 ";; Released under the GNU General Public License version 3\n"
226 ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
228 ";; Template test file for Org-mode tests\n\n"
231 "(let ((load-path (cons (expand-file-name\n"
232 " \"..\" (file-name-directory\n"
233 " (or load-file-name buffer-file-name)))\n"
235 " (require 'org-test)\n"
236 " (require 'org-test-ob-consts))\n\n"
239 "(ert-deftest " name
"/example-test ()\n"
240 " \"Just an example to get you started.\"\n"
242 " (should-not nil)\n"
243 " (should-error (error \"errr...\")))\n\n\n"
244 "(provide '" name
")\n\n"
245 ";;; " file-name
" ends here\n") full-path
))
246 (lambda () ((lambda (res) (if (listp res
) (car res
) res
)) (which-function)))))
248 (define-key emacs-lisp-mode-map
"\M-\C-j" 'org-test-jump
)
251 ;;; Miscellaneous helper functions
252 (defun org-test-strip-text-props (s)
253 "Return S without any text properties."
254 (let ((noprop (copy-sequence s
)))
255 (set-text-properties 0 (length noprop
) nil noprop
)
259 (defun org-test-string-exact-match (regex string
&optional start
)
260 "case sensative string-match"
261 (let ((case-fold-search nil
)
263 (if(and (equal regex
"")
264 (not(equal string
"")))
266 (if (equal 0 (string-match regex string start
))
270 ;;; Load and Run tests
271 (defun org-test-load ()
272 "Load up the org-mode test suite."
275 ;; Recursively load all files, if files throw errors
276 ;; then silently ignore the error and continue to the
277 ;; next file. This allows files to error out if
278 ;; required executables aren't available.
281 (if (file-directory-p path
)
284 (when (string-match "^[A-Za-z].*\\.el$"
285 (file-name-nondirectory path
))
287 (missing-test-dependency
289 (concat "org-missing-dependency/"
290 (file-name-nondirectory
291 (file-name-sans-extension path
))))))
292 (eval `(ert-deftest ,name
()
293 :expected-result
:failed
(should nil
))))))))
294 (directory-files base
'full
295 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
296 (rld (expand-file-name "lisp" org-test-dir
))
297 (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir
)))))
299 (defun org-test-current-defun ()
300 "Test the current function."
302 (ert (which-function)))
304 (defun org-test-current-file ()
305 "Run all tests for current file."
308 (file-name-sans-extension
309 (file-name-nondirectory (buffer-file-name)))
312 (defun org-test-touch-all-examples ()
313 (dolist (file (directory-files
314 org-test-example-dir
'full
315 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
318 (defun org-test-update-id-locations ()
319 (org-id-update-id-locations
321 org-test-example-dir
'full
322 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$")))
324 (defun org-test-run-batch-tests ()
325 "Run all defined tests matching \"\\(org\\|ob\\)\".
326 Load all test files first."
328 (let ((org-id-track-globally t
)
329 (org-id-locations-file
330 (convert-standard-filename
332 "testing/.test-org-id-locations"
334 (org-test-touch-all-examples)
335 (org-test-update-id-locations)
337 (ert-run-tests-batch-and-exit "\\(org\\|ob\\)")))
339 (defun org-test-run-all-tests ()
340 "Run all defined tests matching \"\\(org\\|ob\\)\".
341 Load all test files first."
343 (org-test-touch-all-examples)
345 (ert "\\(org\\|ob\\)"))
349 ;;; org-test.el ends here