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 (let ((org-lisp-dir (expand-file-name
37 (concat org-test-dir
"../lisp"))))
38 (unless (featurep 'org
)
39 (setq load-path
(cons org-lisp-dir load-path
))
40 (org-babel-do-load-languages
41 'org-babel-load-languages
'((sh . t
)))))
42 (let* ((load-path (cons
43 (expand-file-name "ert" org-test-dir
)
45 (expand-file-name "jump" org-test-dir
)
48 (when (= emacs-major-version
22)
49 (defvar special-mode-map
50 (let ((map (make-sparse-keymap)))
52 (define-key map
"q" 'quit-window
)
53 (define-key map
" " 'scroll-up
)
54 (define-key map
"\C-?" 'scroll-down
)
55 (define-key map
"?" 'describe-mode
)
56 (define-key map
"h" 'describe-mode
)
57 (define-key map
">" 'end-of-buffer
)
58 (define-key map
"<" 'beginning-of-buffer
)
59 (define-key map
"g" 'revert-buffer
)
60 (define-key map
"z" 'kill-this-buffer
)
63 (put 'special-mode
'mode-class
'special
)
64 (define-derived-mode special-mode nil
"Special"
65 "Parent major mode from which special major modes should inherit."
66 (setq buffer-read-only t
)))
70 (expand-file-name "jump/jump.el" org-test-dir
))
72 (require 'which-func
))
75 (defconst org-test-default-test-file-name
"tests.el"
76 "For each defun a separate file with tests may be defined.
77 tests.el is the fallback or default if you like.")
79 (defconst org-test-default-directory-name
"testing"
80 "Basename or the directory where the tests live.
81 org-test searches this directory up the directory tree.")
83 (defconst org-test-dir
84 (expand-file-name (file-name-directory (or load-file-name buffer-file-name
))))
86 (defconst org-base-dir
87 (expand-file-name ".." org-test-dir
))
89 (defconst org-test-example-dir
90 (expand-file-name "examples" org-test-dir
))
92 (defconst org-test-file
93 (expand-file-name "normal.org" org-test-example-dir
))
95 (defconst org-test-no-heading-file
96 (expand-file-name "no-heading.org" org-test-example-dir
))
98 (defconst org-test-link-in-heading-file
99 (expand-file-name "link-in-heading.org" org-test-dir
))
102 ;;; Functions for writing tests
103 (defun org-test-buffer (&optional file
)
104 "TODO: Setup and return a buffer to work with.
105 If file is non-nil insert it's contents in there.")
107 (defun org-test-compare-with-file (&optional file
)
108 "TODO: Compare the contents of the test buffer with FILE.
109 If file is not given, search for a file named after the test
110 currently executed.")
112 (defmacro org-test-at-id
(id &rest body
)
113 "Run body after placing the point in the headline identified by ID."
115 `(let* ((id-location (org-id-find ,id
))
116 (id-file (car id-location
))
117 (visited-p (get-file-buffer id-file
))
119 (save-window-excursion
122 (setq to-be-removed
(current-buffer))
126 (org-show-block-all))
128 (save-restriction ,@body
)))
130 (kill-buffer to-be-removed
))))
132 (defmacro org-test-in-example-file
(file &rest body
)
133 "Execute body in the Org-mode example file."
135 `(let* ((my-file (or ,file org-test-file
))
136 (visited-p (get-file-buffer my-file
))
138 (save-window-excursion
141 (setq to-be-removed
(current-buffer))
142 (goto-char (point-min))
145 (outline-next-visible-heading 1)
147 (org-show-block-all))
149 (save-restriction ,@body
)))
151 (kill-buffer to-be-removed
))))
153 (defmacro org-test-at-marker
(file marker
&rest body
)
154 "Run body after placing the point at MARKER in FILE.
155 Note the uuidgen command-line command can be useful for
156 generating unique markers for insertion as anchors into org
159 `(org-test-in-example-file ,file
160 (goto-char (point-min))
161 (re-search-forward (regexp-quote ,marker
))
165 ;;; Navigation Functions
166 (when (featurep 'jump
)
167 (defjump org-test-jump
168 (("lisp/\\1.el" .
"testing/lisp/test-\\1.el")
169 ("lisp/\\1.el" .
"testing/lisp/\\1.el/test.*.el")
170 ("contrib/lisp/\\1.el" .
"testing/contrib/lisp/test-\\1.el")
171 ("contrib/lisp/\\1.el" .
"testing/contrib/lisp/\\1.el/test.*.el")
172 ("testing/lisp/test-\\1.el" .
"lisp/\\1.el")
173 ("testing/lisp/\\1.el" .
"lisp/\\1.el/test.*.el")
174 ("testing/contrib/lisp/test-\\1.el" .
"contrib/lisp/\\1.el")
175 ("testing/contrib/lisp/test-\\1.el" .
"contrib/lisp/\\1.el/test.*.el"))
176 (concat org-base-dir
"/")
177 "Jump between org-mode files and their tests."
179 (let* ((full-path (expand-file-name path org-base-dir
))
180 (file-name (file-name-nondirectory path
))
181 (name (file-name-sans-extension file-name
)))
182 (find-file full-path
)
184 ";;; " file-name
"\n\n"
185 ";; Copyright (c) " (nth 5 (decode-time (current-time)))
186 " " user-full-name
"\n"
187 ";; Authors: " user-full-name
"\n\n"
188 ";; Released under the GNU General Public License version 3\n"
189 ";; see: http://www.gnu.org/licenses/gpl-3.0.html\n\n"
191 ";; Template test file for Org-mode tests\n\n"
194 "(let ((load-path (cons (expand-file-name\n"
195 " \"..\" (file-name-directory\n"
196 " (or load-file-name buffer-file-name)))\n"
198 " (require 'org-test)\n"
199 " (require 'org-test-ob-consts))\n\n"
202 "(ert-deftest " name
"/example-test ()\n"
203 " \"Just an example to get you started.\"\n"
205 " (should-not nil)\n"
206 " (should-error (error \"errr...\")))\n\n\n"
207 "(provide '" name
")\n\n"
208 ";;; " file-name
" ends here\n") full-path
))
209 (lambda () ((lambda (res) (if (listp res
) (car res
) res
)) (which-function)))))
211 (define-key emacs-lisp-mode-map
"\M-\C-j" 'org-test-jump
)
214 ;;; Miscellaneous helper functions
215 (defun org-test-strip-text-props (s)
216 "Return S without any text properties."
217 (let ((noprop (copy-sequence s
)))
218 (set-text-properties 0 (length noprop
) nil noprop
)
222 (defun org-test-string-exact-match (regex string
&optional start
)
223 "case sensative string-match"
224 (let ((case-fold-search nil
)
226 (if(and (equal regex
"")
227 (not(equal string
"")))
229 (if (equal 0 (string-match regex string start
))
233 ;;; Load and Run tests
234 (defun org-test-load ()
235 "Load up the org-mode test suite."
240 (if (file-directory-p path
) (rload path
) (load-file path
)))
241 (directory-files base
'full
242 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
243 (rload (expand-file-name "lisp" org-test-dir
))
244 (rload (expand-file-name "lisp"
245 (expand-file-name "contrib" org-test-dir
)))))
247 (defun org-test-current-defun ()
248 "Test the current function."
250 (ert (which-function)))
252 (defun org-test-current-file ()
253 "Run all tests for current file."
256 (file-name-sans-extension
257 (file-name-nondirectory (buffer-file-name)))
260 (defun org-test-touch-all-examples ()
261 (dolist (file (directory-files
262 org-test-example-dir
'full
263 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
266 (defun org-test-run-batch-tests ()
267 "Run all defined tests matching \"\\(org\\|ob\\)\".
268 Load all test files first."
270 (org-test-touch-all-examples)
272 (ert-run-tests-batch-and-exit "\\(org\\|ob\\)"))
274 (defun org-test-run-all-tests ()
275 "Run all defined tests matching \"\\(org\\|ob\\)\".
276 Load all test files first."
278 (org-test-touch-all-examples)
280 (ert "\\(org\\|ob\\)"))
284 ;;; org-test.el ends here