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
9 ;; Package-Requires: ((cl-lib "0"))
12 ;; This program is free software: you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation, either version 3 of the
15 ;; License, or (at your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see
24 ;; <http://www.gnu.org/licenses/>.
30 ;; * Simple. No need for
32 ;; - enclosing specifications,
33 ;; - required test tags.
35 ;; But if you want, you still can enclose tests in a local scope,
36 ;; add customized assert failure messages, or add summary messages
37 ;; before a group of tests.
39 ;; * Accomodates both interactive and non-interactive use.
40 ;; - For interactive use, one can use `eval-last-sexp', `eval-region',
41 ;; and `eval-buffer'. One can `edebug' the code.
42 ;; - For non-interactive use, run:
43 ;; emacs --batch --no-site-file --no-splash --load <test-lisp-code.el>
45 ;; Here is an example using gcd.el found in the examples directory.
47 ;; (require 'test-simple)
48 ;; (test-simple-start) ;; Zero counters and start the stop watch.
50 ;; ;; Use (load-file) below because we want to always to read the source.
51 ;; ;; Also, we don't want no stinking compiled source.
52 ;; (assert-t (load-file "./gcd.el")
53 ;; "Can't load gcd.el - are you in the right directory?" )
55 ;; (note "degenerate cases")
57 ;; (assert-nil (gcd 5 -1) "using positive numbers")
58 ;; (assert-nil (gcd -4 1) "using positive numbers, switched order")
59 ;; (assert-raises error (gcd "a" 32)
60 ;; "Passing a string value should raise an error")
62 ;; (note "GCD computations")
63 ;; (assert-equal 1 (gcd 3 5) "gcd(3,5)")
64 ;; (assert-equal 8 (gcd 8 32) "gcd(8,32)")
65 ;; (end-tests) ;; Stop the clock and print a summary
67 ;; Edit (with Emacs of course) test-gcd.el and run M-x eval-current-buffer
69 ;; You should see in buffer *test-simple*:
73 ;; 0 failures in 6 assertions (0.002646 seconds)
75 ;; Now let us try from a command line:
77 ;; $ emacs --batch --no-site-file --no-splash --load test-gcd.el
78 ;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
81 ;; 0 failures in 6 assertions (0.000723 seconds)
85 ;; FIXME: Namespace is all messed up!
86 ;; Main issues: more expect predicates
92 (eval-when-compile (require 'cl-lib))
94 (defvar test-simple-debug-on-error nil
95 "If non-nil raise an error on the first failure.")
97 (defvar test-simple-verbosity 0
98 "The greater the number the more verbose output.")
100 (cl-defstruct test-info
101 description ;; description of last group of tests
102 (assert-count 0) ;; total number of assertions run
103 (failure-count 0) ;; total number of failures seen
104 (start-time (current-time)) ;; Time run started
107 (defvar test-simple-info (make-test-info)
108 "Variable to store testing information for a buffer.")
110 (defun note (description &optional test-info)
111 "Add a name to a group of tests."
112 (if (getenv "USE_TAP")
113 (test-simple-msg (format "# %s" description) 't)
114 (if (> test-simple-verbosity 0)
115 (test-simple-msg (concat "\n" description) 't))
117 (setq test-info test-simple-info))
118 (setf (test-info-description test-info) description)
122 (defmacro test-simple-start (&optional test-start-msg)
123 `(test-simple-clear nil
125 (if (and (functionp '__FILE__) (__FILE__))
126 (file-name-nondirectory (__FILE__))
131 (defun test-simple-clear (&optional test-info test-start-msg)
132 "Initialize and reset everything to run tests.
133 You should run this before running any assertions. Running more than once
134 clears out information from the previous run."
139 (setq test-info test-simple-info))
141 (setf (test-info-description test-info) "none set")
142 (setf (test-info-start-time test-info) (current-time))
143 (setf (test-info-assert-count test-info) 0)
144 (setf (test-info-failure-count test-info) 0)
146 (with-current-buffer (get-buffer-create "*test-simple*")
147 (let ((old-read-only inhibit-read-only))
148 (setq inhibit-read-only 't)
149 (delete-region (point-min) (point-max))
150 (if test-start-msg (insert (format "%s\n" test-start-msg)))
151 (setq inhibit-read-only old-read-only)))
152 (unless noninteractive
153 (message "Test-Simple: test information cleared")))
155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159 (defmacro assert-raises (error-condition body &optional fail-message test-info)
160 (let ((fail-message (or fail-message
161 (format "assert-raises did not get expected %s"
163 (list 'condition-case nil
165 (list 'assert-t nil fail-message test-info))
166 (list error-condition '(assert-t t)))))
168 (defun assert-op (op expected actual &optional fail-message test-info)
169 "Expectation is that ACTUAL should be equal to EXPECTED."
170 (unless test-info (setq test-info test-simple-info))
171 (cl-incf (test-info-assert-count test-info))
172 (if (not (funcall op actual expected))
175 (format "Message: %s" fail-message)
178 (format "\n Expected: %s\n Got: %s" expected actual))
180 (if (boundp 'test-info)
181 (test-info-description test-info)
183 (test-simple--add-failure (format "assert-%s" op) test-info-mess
184 (concat fail-message expect-message)))
185 (test-simple--ok-msg fail-message)))
187 (defun assert-equal (expected actual &optional fail-message test-info)
188 "Expectation is that ACTUAL should be equal to EXPECTED."
189 (assert-op 'equal expected actual fail-message test-info))
191 (defun assert-eq (expected actual &optional fail-message test-info)
192 "Expectation is that ACTUAL should be EQ to EXPECTED."
193 (assert-op 'eql expected actual fail-message test-info))
195 (defun assert-eql (expected actual &optional fail-message test-info)
196 "Expectation is that ACTUAL should be EQL to EXPECTED."
197 (assert-op 'eql expected actual fail-message test-info))
199 (defun assert-matches (expected-regexp actual &optional fail-message test-info)
200 "Expectation is that ACTUAL should match EXPECTED-REGEXP."
201 (unless test-info (setq test-info test-simple-info))
202 (cl-incf (test-info-assert-count test-info))
203 (if (not (string-match expected-regexp actual))
206 (format "\n\tMessage: %s" fail-message)
209 (format "\tExpected Regexp: %s\n\tGot: %s"
210 expected-regexp actual))
212 (if (boundp 'test-info)
213 (test-info-description test-info)
215 (test-simple--add-failure "assert-equal" test-info-mess
216 (concat expect-message fail-message)))
217 (progn (test-simple-msg ".") t)))
219 (defun assert-t (actual &optional fail-message test-info)
220 "Expectation is that ACTUAL is not nil."
221 (assert-nil (not actual) fail-message test-info "assert-t"))
223 (defun assert-nil (actual &optional fail-message test-info _assert-type)
224 "Expectation is that ACTUAL is nil.
225 FAIL-MESSAGE is an optional additional message to be displayed.
226 Since several assertions funnel down to this one, ASSERT-TYPE is an
228 (unless test-info (setq test-info test-simple-info))
229 (cl-incf (test-info-assert-count test-info))
233 (format "\n\tMessage: %s" fail-message)
236 (if (boundp 'test-simple-info)
237 (test-info-description test-simple-info)
239 (test-simple--add-failure "assert-nil" test-info-mess
240 fail-message test-info))
241 (test-simple--ok-msg fail-message)))
243 (defun test-simple--add-failure (type test-info-msg fail-msg
245 (unless test-info (setq test-info test-simple-info))
246 (cl-incf (test-info-failure-count test-info))
248 (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
251 (test-simple--not-ok-msg fail-msg)
252 (test-simple-msg failure-msg 't)
253 (unless noninteractive
254 (if test-simple-debug-on-error
255 (signal 'test-simple-assert-failed failure-msg)
256 ;;(message failure-msg)
259 (defun end-tests (&optional test-info)
260 "Give a tally of the tests run."
262 (unless test-info (setq test-info test-simple-info))
263 (test-simple-describe-failures test-info)
266 (switch-to-buffer "*test-simple*")
267 (message "%s" (buffer-substring (point-min) (point-max)))
269 (switch-to-buffer-other-window "*test-simple*")
272 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
276 (defun test-simple-msg(msg &optional newline)
277 (switch-to-buffer "*test-simple*")
278 (let ((inhibit-read-only t))
280 (if newline (insert "\n")))
281 (switch-to-buffer nil))
283 (defun test-simple--ok-msg (fail-message &optional test-info)
284 (unless test-info (setq test-info test-simple-info))
285 (let ((msg (if (getenv "USE_TAP")
286 (if (equal fail-message "")
287 (format "ok %d\n" (test-info-assert-count test-info))
288 (format "ok %d - %s\n"
289 (test-info-assert-count test-info)
292 (test-simple-msg msg))
295 (defun test-simple--not-ok-msg (_fail-message &optional test-info)
296 (unless test-info (setq test-info test-simple-info))
297 (let ((msg (if (getenv "USE_TAP")
298 (format "not ok %d\n" (test-info-assert-count test-info))
300 (test-simple-msg msg))
303 (defun test-simple-summary-line(info)
305 ((failures (test-info-failure-count info))
306 (asserts (test-info-assert-count info))
307 (problems (concat (number-to-string failures) " failure"
308 (unless (= 1 failures) "s")))
309 (tests (concat (number-to-string asserts) " assertion"
310 (unless (= 1 asserts) "s")))
311 (elapsed-time (time-since (test-info-start-time info)))
313 (if (getenv "USE_TAP")
314 (format "1..%d" asserts)
315 (format "\n%s in %s (%g seconds)" problems tests
316 (float-time elapsed-time))
319 (defun test-simple-describe-failures(&optional test-info)
320 (unless test-info (setq test-info test-simple-info))
321 (goto-char (point-max))
322 (test-simple-msg (test-simple-summary-line test-info)))
324 (provide 'test-simple)
325 ;;; test-simple.el ends here