1 ;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
2 ;; Rewritten from Phil Hagelberg's behave.el by rocky
4 ;; Copyright (C) 2015 Free Software Foundation, Inc
6 ;; Author: Rocky Bernstein <rocky@gnu.org>
7 ;; URL: http://github.com/rocky/emacs-test-simple
11 ;; This program is free software: you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation, either version 3 of the
14 ;; License, or (at your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see
23 ;; <http://www.gnu.org/licenses/>.
29 ;; * Simple. No need for
31 ;; - enclosing specifications,
32 ;; - required test tags.
34 ;; But if you want, you still can enclose tests in a local scope,
35 ;; add customized assert failure messages, or add summary messages
36 ;; before a group of tests.
38 ;; * Accomodates both interactive and non-interactive use.
39 ;; - For interactive use, one can use `eval-last-sexp', `eval-region',
40 ;; and `eval-buffer'. One can `edebug' the code.
41 ;; - For non-interactive use, run:
42 ;; emacs --batch --no-site-file --no-splash --load <test-lisp-code.el>
44 ;; Here is an example using gcd.el found in the examples directory.
46 ;; (require 'test-simple)
47 ;; (test-simple-start) ;; Zero counters and start the stop watch.
49 ;; ;; Use (load-file) below because we want to always to read the source.
50 ;; ;; Also, we don't want no stinking compiled source.
51 ;; (assert-t (load-file "./gcd.el")
52 ;; "Can't load gcd.el - are you in the right directory?" )
54 ;; (note "degenerate cases")
56 ;; (assert-nil (gcd 5 -1) "using positive numbers")
57 ;; (assert-nil (gcd -4 1) "using positive numbers, switched order")
58 ;; (assert-raises error (gcd "a" 32)
59 ;; "Passing a string value should raise an error")
61 ;; (note "GCD computations")
62 ;; (assert-equal 1 (gcd 3 5) "gcd(3,5)")
63 ;; (assert-equal 8 (gcd 8 32) "gcd(8,32)")
64 ;; (end-tests) ;; Stop the clock and print a summary
66 ;; Edit (with Emacs of course) test-gcd.el and run M-x eval-current-buffer
68 ;; You should see in buffer *test-simple*:
72 ;; 0 failures in 6 assertions (0.002646 seconds)
74 ;; Now let us try from a command line:
76 ;; $ emacs --batch --no-site-file --no-splash --load test-gcd.el
77 ;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
80 ;; 0 failures in 6 assertions (0.000723 seconds)
84 ;; Main issues: more expect predicates
91 (byte-compile-disable-warning 'cl-functions)
92 ;; Somehow disabling cl-functions causes the erroneous message:
93 ;; Warning: the function `reduce' might not be defined at runtime.
94 ;; FIXME: isolate, fix and/or report back to Emacs developers a bug
95 ;; (byte-compile-disable-warning 'unresolved)
100 (defvar test-simple-debug-on-error nil
101 "If non-nil raise an error on the first failure.")
103 (defvar test-simple-verbosity 0
104 "The greater the number the more verbose output.")
107 description ;; description of last group of tests
108 (assert-count 0) ;; total number of assertions run
109 (failure-count 0) ;; total number of failures seen
110 (start-time (current-time)) ;; Time run started
113 (defvar test-simple-info (make-test-info)
114 "Variable to store testing information for a buffer.")
116 (defun note (description &optional test-info)
117 "Adds a name to a group of tests."
118 (if (getenv "USE_TAP")
119 (test-simple-msg (format "# %s" description) 't)
120 (if (> test-simple-verbosity 0)
121 (test-simple-msg (concat "\n" description) 't))
123 (setq test-info test-simple-info))
124 (setf (test-info-description test-info) description)
128 (defmacro test-simple-start (&optional test-start-msg)
129 `(test-simple-clear nil
131 (if (and (functionp '__FILE__) (__FILE__))
132 (file-name-nondirectory (__FILE__))
137 (defun test-simple-clear (&optional test-info test-start-msg)
138 "Initializes and resets everything to run tests. You should run
139 this before running any assertions. Running more than once clears
140 out information from the previous run."
145 (unless test-simple-info
146 (make-variable-buffer-local (defvar test-simple-info (make-test-info))))
147 (setq test-info test-simple-info))
149 (setf (test-info-description test-info) "none set")
150 (setf (test-info-start-time test-info) (current-time))
151 (setf (test-info-assert-count test-info) 0)
152 (setf (test-info-failure-count test-info) 0)
154 (with-current-buffer (get-buffer-create "*test-simple*")
155 (let ((old-read-only inhibit-read-only))
156 (setq inhibit-read-only 't)
157 (delete-region (point-min) (point-max))
158 (if test-start-msg (insert (format "%s\n" test-start-msg)))
159 (setq inhibit-read-only old-read-only)))
160 (unless noninteractive
161 (message "Test-Simple: test information cleared")))
163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
167 (defmacro assert-raises (error-condition body &optional fail-message test-info)
168 (let ((fail-message (or fail-message
169 (format "assert-raises did not get expected %s"
171 (list 'condition-case nil
173 (list 'assert-t nil fail-message test-info))
174 (list error-condition '(assert-t t)))))
176 (defun assert-op (op expected actual &optional fail-message test-info)
177 "expectation is that ACTUAL should be equal to EXPECTED."
178 (unless test-info (setq test-info test-simple-info))
179 (incf (test-info-assert-count test-info))
180 (if (not (funcall op actual expected))
183 (format "Message: %s" fail-message)
186 (format "\n Expected: %s\n Got: %s" expected actual))
188 (if (boundp 'test-info)
189 (test-info-description test-info)
191 (add-failure (format "assert-%s" op) test-info-mess
192 (concat fail-message expect-message)))
193 (ok-msg fail-message)))
195 (defun assert-equal (expected actual &optional fail-message test-info)
196 "expectation is that ACTUAL should be equal to EXPECTED."
197 (assert-op 'equal expected actual fail-message test-info))
199 (defun assert-eq (expected actual &optional fail-message test-info)
200 "expectation is that ACTUAL should be EQ to EXPECTED."
201 (assert-op 'eql expected actual fail-message test-info))
203 (defun assert-eql (expected actual &optional fail-message test-info)
204 "expectation is that ACTUAL should be EQL to EXPECTED."
205 (assert-op 'eql expected actual fail-message test-info))
207 (defun assert-matches (expected-regexp actual &optional fail-message test-info)
208 "expectation is that ACTUAL should match EXPECTED-REGEXP."
209 (unless test-info (setq test-info test-simple-info))
210 (incf (test-info-assert-count test-info))
211 (if (not (string-match expected-regexp actual))
214 (format "\n\tMessage: %s" fail-message)
217 (format "\tExpected Regexp: %s\n\tGot: %s"
218 expected-regexp actual))
220 (if (boundp 'test-info)
221 (test-info-description test-info)
223 (add-failure "assert-equal" test-info-mess
224 (concat expect-message fail-message)))
225 (progn (test-simple-msg ".") t)))
227 (defun assert-t (actual &optional fail-message test-info)
228 "expectation is that ACTUAL is not nil."
229 (assert-nil (not actual) fail-message test-info "assert-t"))
231 (defun assert-nil (actual &optional fail-message test-info assert-type)
232 "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
233 additional message to be displayed. Since several assertions
234 funnel down to this one, ASSERT-TYPE is an optional type."
235 (unless test-info (setq test-info test-simple-info))
236 (incf (test-info-assert-count test-info))
240 (format "\n\tMessage: %s" fail-message)
243 (if (boundp 'test-simple-info)
244 (test-info-description test-simple-info)
246 (add-failure "assert-nil" test-info-mess fail-message test-info))
247 (ok-msg fail-message)))
249 (defun add-failure(type test-info-msg fail-msg &optional test-info)
250 (unless test-info (setq test-info test-simple-info))
251 (incf (test-info-failure-count test-info))
253 (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
254 (old-read-only inhibit-read-only)
257 (not-ok-msg fail-msg)
258 (test-simple-msg failure-msg 't)
259 (unless noninteractive
260 (if test-simple-debug-on-error
261 (signal 'test-simple-assert-failed failure-msg)
262 ;;(message failure-msg)
265 (defun end-tests (&optional test-info)
266 "Give a tally of the tests run"
268 (unless test-info (setq test-info test-simple-info))
269 (test-simple-describe-failures test-info)
272 (switch-to-buffer "*test-simple*")
273 (message "%s" (buffer-substring (point-min) (point-max)))
275 (switch-to-buffer-other-window "*test-simple*")
278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
282 (defun test-simple-msg(msg &optional newline)
283 (switch-to-buffer "*test-simple*")
284 (let ((old-read-only inhibit-read-only))
285 (setq inhibit-read-only 't)
287 (if newline (insert "\n"))
288 (setq inhibit-read-only old-read-only)
289 (switch-to-buffer nil)
292 (defun ok-msg(fail-message &optional test-info)
293 (unless test-info (setq test-info test-simple-info))
294 (let ((msg (if (getenv "USE_TAP")
295 (if (equal fail-message "")
296 (format "ok %d\n" (test-info-assert-count test-info))
297 (format "ok %d - %s\n"
298 (test-info-assert-count test-info)
301 (test-simple-msg msg))
304 (defun not-ok-msg(fail-message &optional test-info)
305 (unless test-info (setq test-info test-simple-info))
306 (let ((msg (if (getenv "USE_TAP")
307 (format "not ok %d\n" (test-info-assert-count test-info))
309 (test-simple-msg msg))
312 (defun test-simple-summary-line(info)
314 ((failures (test-info-failure-count info))
315 (asserts (test-info-assert-count info))
316 (problems (concat (number-to-string failures) " failure"
317 (unless (= 1 failures) "s")))
318 (tests (concat (number-to-string asserts) " assertion"
319 (unless (= 1 asserts) "s")))
320 (elapsed-time (time-since (test-info-start-time info)))
322 (if (getenv "USE_TAP")
323 (format "1..%d" asserts)
324 (format "\n%s in %s (%g seconds)" problems tests
325 (float-time elapsed-time))
328 (defun test-simple-describe-failures(&optional test-info)
329 (unless test-info (setq test-info test-simple-info))
330 (goto-char (point-max))
331 (test-simple-msg (test-simple-summary-line test-info)))
333 (provide 'test-simple)
334 ;;; test-simple.el ends here