1 ;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp -*- lexical-binding: t -*-
2 ;; Rewritten from Phil Hagelberg's behave.el by rocky
4 ;; Copyright (C) 2015, 2016 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 ;; * Accommodates 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) gcd-tests.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 gcd-tests.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 (defgroup test-simple nil
95 "Simple Unit Test Framework for Emacs Lisp"
98 (defcustom test-simple-runner-interface (if (fboundp 'bpr-spawn)
101 "Function with one string argument when running tests non-interactively.
102 Command line started with `emacs --batch' is passed as the argument.
104 `bpr-spawn', which is in bpr package, is preferable because of no window popup.
105 If bpr is not installed, fall back to `compile'."
109 (defcustom test-simple-runner-key "C-x C-z"
110 "Key to run non-interactive test after defining command line by `test-simple-run'."
114 (defvar test-simple-debug-on-error nil
115 "If non-nil raise an error on the first failure.")
117 (defvar test-simple-verbosity 0
118 "The greater the number the more verbose output.")
120 (cl-defstruct test-info
121 description ;; description of last group of tests
122 (assert-count 0) ;; total number of assertions run
123 (failure-count 0) ;; total number of failures seen
124 (start-time (current-time)) ;; Time run started
127 (defvar test-simple-info (make-test-info)
128 "Variable to store testing information for a buffer.")
130 (defun note (description &optional test-info)
131 "Add a name to a group of tests."
132 (if (getenv "USE_TAP")
133 (test-simple-msg (format "# %s" description) 't)
134 (if (> test-simple-verbosity 0)
135 (test-simple-msg (concat "\n" description) 't))
137 (setq test-info test-simple-info))
138 (setf (test-info-description test-info) description)
142 (defmacro test-simple-start (&optional test-start-msg)
143 `(test-simple-clear nil
145 (if (and (functionp '__FILE__) (__FILE__))
146 (file-name-nondirectory (__FILE__))
151 (defun test-simple-clear (&optional test-info test-start-msg)
152 "Initialize and reset everything to run tests.
153 You should run this before running any assertions. Running more than once
154 clears out information from the previous run."
159 (setq test-info test-simple-info))
161 (setf (test-info-description test-info) "none set")
162 (setf (test-info-start-time test-info) (current-time))
163 (setf (test-info-assert-count test-info) 0)
164 (setf (test-info-failure-count test-info) 0)
166 (with-current-buffer (get-buffer-create "*test-simple*")
167 (let ((old-read-only inhibit-read-only))
168 (setq inhibit-read-only 't)
169 (delete-region (point-min) (point-max))
170 (if test-start-msg (insert (format "%s\n" test-start-msg)))
171 (setq inhibit-read-only old-read-only)))
172 (unless noninteractive
173 (message "Test-Simple: test information cleared")))
175 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
179 (defmacro assert-raises (error-condition body &optional fail-message)
180 (let ((fail-message (or fail-message
181 (format "assert-raises did not get expected %s"
183 (list 'condition-case nil
185 (list 'assert-t nil fail-message))
186 (list error-condition '(assert-t t)))))
188 (defun assert-op (op expected actual &optional fail-message test-info)
189 "Expectation is that ACTUAL should be equal to EXPECTED."
190 (unless test-info (setq test-info test-simple-info))
191 (cl-incf (test-info-assert-count test-info))
192 (if (not (funcall op actual expected))
195 (format "Message: %s" fail-message)
198 (format "\n Expected: %S\n Got: %S" expected actual))
200 (if (boundp 'test-info)
201 (test-info-description test-info)
203 (test-simple--add-failure (format "assert-%s" op) test-info-mess
204 (concat fail-message expect-message)))
205 (test-simple--ok-msg fail-message)))
207 (defun assert-equal (expected actual &optional fail-message test-info)
208 "Expectation is that ACTUAL should be equal to EXPECTED."
209 (assert-op 'equal expected actual fail-message test-info))
211 (defun assert-eq (expected actual &optional fail-message test-info)
212 "Expectation is that ACTUAL should be EQ to EXPECTED."
213 (assert-op 'eql expected actual fail-message test-info))
215 (defun assert-eql (expected actual &optional fail-message test-info)
216 "Expectation is that ACTUAL should be EQL to EXPECTED."
217 (assert-op 'eql expected actual fail-message test-info))
219 (defun assert-matches (expected-regexp actual &optional fail-message test-info)
220 "Expectation is that ACTUAL should match EXPECTED-REGEXP."
221 (unless test-info (setq test-info test-simple-info))
222 (cl-incf (test-info-assert-count test-info))
223 (if (not (string-match expected-regexp actual))
226 (format "\n\tMessage: %s" fail-message)
229 (format "\tExpected Regexp: %s\n\tGot: %s"
230 expected-regexp actual))
232 (if (boundp 'test-info)
233 (test-info-description test-info)
235 (test-simple--add-failure "assert-equal" test-info-mess
236 (concat expect-message fail-message)))
237 (progn (test-simple-msg ".") t)))
239 (defun assert-t (actual &optional fail-message test-info)
240 "expectation is that ACTUAL is not nil."
241 (assert-nil (not actual) fail-message test-info))
243 (defun assert-nil (actual &optional fail-message test-info)
244 "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
245 additional message to be displayed."
246 (unless test-info (setq test-info test-simple-info))
247 (cl-incf (test-info-assert-count test-info))
251 (format "\n\tMessage: %s" fail-message)
254 (if (boundp 'test-simple-info)
255 (test-info-description test-simple-info)
257 (test-simple--add-failure "assert-nil" test-info-mess
258 fail-message test-info))
259 (test-simple--ok-msg fail-message)))
261 (defun test-simple--add-failure (type test-info-msg fail-msg
263 (unless test-info (setq test-info test-simple-info))
264 (cl-incf (test-info-failure-count test-info))
266 (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
269 (test-simple--not-ok-msg fail-msg)
270 (test-simple-msg failure-msg 't)
271 (unless noninteractive
272 (if test-simple-debug-on-error
273 (signal 'test-simple-assert-failed failure-msg)
274 ;;(message failure-msg)
277 (defun end-tests (&optional test-info)
278 "Give a tally of the tests run."
280 (unless test-info (setq test-info test-simple-info))
281 (test-simple-describe-failures test-info)
284 (switch-to-buffer "*test-simple*")
285 (message "%s" (buffer-substring (point-min) (point-max)))
287 (switch-to-buffer-other-window "*test-simple*")
290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
292 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
294 (defun test-simple-msg(msg &optional newline)
295 (switch-to-buffer "*test-simple*")
296 (let ((inhibit-read-only t))
298 (if newline (insert "\n")))
299 (switch-to-buffer nil))
301 (defun test-simple--ok-msg (fail-message &optional test-info)
302 (unless test-info (setq test-info test-simple-info))
303 (let ((msg (if (getenv "USE_TAP")
304 (if (equal fail-message "")
305 (format "ok %d\n" (test-info-assert-count test-info))
306 (format "ok %d - %s\n"
307 (test-info-assert-count test-info)
310 (test-simple-msg msg))
313 (defun test-simple--not-ok-msg (_fail-message &optional test-info)
314 (unless test-info (setq test-info test-simple-info))
315 (let ((msg (if (getenv "USE_TAP")
316 (format "not ok %d\n" (test-info-assert-count test-info))
318 (test-simple-msg msg))
321 (defun test-simple-summary-line(info)
323 ((failures (test-info-failure-count info))
324 (asserts (test-info-assert-count info))
325 (problems (concat (number-to-string failures) " failure"
326 (unless (= 1 failures) "s")))
327 (tests (concat (number-to-string asserts) " assertion"
328 (unless (= 1 asserts) "s")))
329 (elapsed-time (time-since (test-info-start-time info)))
331 (if (getenv "USE_TAP")
332 (format "1..%d" asserts)
333 (format "\n%s in %s (%g seconds)" problems tests
334 (float-time elapsed-time))
337 (defun test-simple-describe-failures(&optional test-info)
338 (unless test-info (setq test-info test-simple-info))
339 (goto-char (point-max))
340 (test-simple-msg (test-simple-summary-line test-info)))
343 (defun test-simple-run (&rest command-line-formats)
344 "Register command line to run tests non-interactively and bind key to run test.
345 After calling this function, you can run test by key specified by `test-simple-runner-key'.
347 It is preferable to write at the first line of test files as a comment, e.g,
348 ;;;; (test-simple-run \"emacs -batch -L %s -l %s\" (file-name-directory (locate-library \"test-simple.elc\")) buffer-file-name)
350 Calling this function interactively, COMMAND-LINE-FORMATS is set above."
352 (setq command-line-formats
353 (or command-line-formats
354 (list "emacs -batch -L %s -l %s"
355 (file-name-directory (locate-library "test-simple.elc"))
357 (let ((func (lambda ()
359 (funcall test-simple-runner-interface
360 (apply 'format command-line-formats)))))
361 (global-set-key (kbd test-simple-runner-key) func)
364 (defun test-simple-noninteractive-kill-emacs-hook ()
365 "Emacs exits abnormally when noninteractive test fails."
366 (when (and noninteractive test-simple-info
367 (<= 1 (test-info-failure-count test-simple-info)))
368 (let (kill-emacs-hook)
371 (add-hook 'kill-emacs-hook 'test-simple-noninteractive-kill-emacs-hook))
374 (provide 'test-simple)
375 ;;; test-simple.el ends here