1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
;;; elk-test.el --- Emacs Lisp testing suite
;; Copyright (C) 2006 Nikolaj Schumacher <bugs * nschum , de>
;;; License
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; Usage
;; Use `deftest' to define a test and `run-elk-test' to run it.
;; Create test bundles with `defsuite' or `build-suite'.
;; Verify your code with `assert-equal', `assert-eq', `assert-eql',
;; `assert-nonnil', `assert-t', `assert-nil' and `assert-error'
;; to verify your code.
;;; Examples
;; (deftest "test1"
;; (assert-equal t t)
;; (assert-eq t 'foo))
;; (defsuite "suite1"
;; (deftest "test1" (assert-equal t t)))
;; (deftest "test2"
;; (assert-equal t t))
;; (build-suite "combined-suite" "test1" "test2")
;; (run-elk-test "combined-suite")
;; (run-elk-test)
(require 'cl)
(defvar elk-test-run-on-define nil
"If non-nil, run elk-test tests/suites immediately when defining them.")
(defvar elk-test-map (make-hash-table :test 'equal)
"A map of elk-test test/suite names to their implementation.")
(defvar elk-test-list nil
"A list of all defined elk-test tests/suites.")
(defun elk-test-clear ()
"Remove all tests from memory."
(setq elk-test-map (make-hash-table :test 'equal)
elk-test-list nil))
(defun run-elk-test (name &optional string-result)
"Run the test case defined as NAME.
The result is a list of errors strings, unless STRING-RESULT is set, in which
case a message describing the errors or success is displayed and returned."
(interactive
(list (completing-read "Test name: " elk-test-list nil t)))
(let ((name name))
(let ((elk-test-errors nil)
(test-or-suite (gethash name elk-test-map)))
(if (not test-or-suite)
(error "Undefined test <%s>" name)
(if (equal (car test-or-suite) 'suite)
;; is test suite
(let ((map (cadr test-or-suite)))
(dolist (test (caddr test-or-suite))
(setq elk-test-errors
(append elk-test-errors
(run-elk-test-internal (gethash test map))))))
;; is simple test
(setq elk-test-errors (run-elk-test-internal test-or-suite)))
(if (or string-result (interactive-p))
(message (if elk-test-errors
(mapconcat 'identity elk-test-errors "\n")
"Test run was successful."))
elk-test-errors)))))
(defun run-elk-tests-buffer (&optional buffer)
"Execute BUFFER as lisp code and run all tests therein."
(interactive)
(let* ((elk-test-list)
(elk-test-map (make-hash-table :test 'equal))
(elk-test-run-on-define nil)
(inhibit-read-only t)
(buffer-name (buffer-name buffer))
(success t)
(parse-res (condition-case err (eval-buffer buffer) (error err))))
(if parse-res
(message "Parsing buffer <%s> failed:\n%s"
buffer-name parse-res)
(let ((out-buffer (get-buffer-create
(concat "*elk-test run " buffer-name "*")))
failure)
(with-current-buffer out-buffer
(erase-buffer)
(dolist (test elk-test-list)
(message "running <%s>" test)
(let ((results (run-elk-test test)))
(when results
(setq failure t)
(insert "test <" test "> failed:\n")
(dolist (result results)
(insert "* " result "\n"))))))
(if failure
(display-buffer out-buffer)
(kill-buffer out-buffer)
(message "Test run was successful."))))))
(defun run-elk-test-internal (test)
(let ((elk-test-errors nil))
(dolist (sexpr test)
(let ((problem (condition-case err (progn (eval sexpr) nil) (error err))))
(when problem
(push (message "%s" problem) elk-test-errors))))
elk-test-errors))
(defmacro elk-test-error (format-string &rest args)
"Create an error string as the result of a failed elk-test assertion.
The first argument is a format control string, and the rest are data to be
formatted under control of the string. See `format' for details.
The result will be displayed, returned and if called inside of `run-elk-test'
added to the internal error list."
`(let ((string (message ,format-string ,@args)))
(when (boundp 'elk-test-errors)
(push string elk-test-errors))
string))
(defmacro assert-equal (expected actual)
"Assert that ACTUAL equals EXPECTED, or signal a warning."
`(unless (equal ,expected ,actual)
(elk-test-error "assert-equal for <%s> failed: expected <%s>, was <%s>"
',actual ,expected ,actual)))
(defmacro assert-eq (expected actual)
"Assert that ACTUAL equals EXPECTED, or signal a warning."
`(unless (eq ,expected ,actual)
(elk-test-error "assert-eq for <%s> failed: expected <%s>, was <%s>"
',actual ,expected ,actual)))
(defmacro assert-eql (expected actual)
"Assert that ACTUAL equals EXPECTED, or signal a warning."
`(unless (eql ,expected ,actual)
(elk-test-error "assert-eql for <%s> failed: expected <%s>, was <%s>"
',actual ,expected ,actual)))
(defmacro assert-nonnil (value)
"Assert that VALUE is not nil, or signal a warning."
`(unless ,value
(elk-test-error "assert-nonnil for <%s> failed: was <%s>"
',value ,value)))
(defmacro assert-t (value)
"Assert that VALUE is t, or signal a warning."
`(unless (eq ,value t)
(elk-test-error "assert-t for <%s> failed: was <%s>"
',value ,value)))
(defmacro assert-nil (value)
"Assert that VALUE is nil, or signal a warning."
`(when ,value
(elk-test-error "assert-nil for <%s> failed: was <%s>"
',value ,value)))
(defmacro assert-error (error-message &rest body)
"Assert that BODY raises an `error', or signal a warning.
ERROR-MESSAGE is the expected error string, use nil to accept any error. Use
nil with caution, as errors like 'wrong-number-of-arguments' (likely caused by
typos) will also be caught!"
`(let ((elk-test-error
(condition-case elk-test-error
(progn ,@body)
(error (cons 'elk-test-error (cadr elk-test-error))))))
(if (not (eq (car elk-test-error) 'elk-test-error))
;; no error
(elk-test-error "assert-error for <%s> failed: did not raise an error"
(append '(progn) ',body))
(when (and ,error-message
(not (equal ,error-message (cdr elk-test-error))))
(elk-test-error (concat "assert-error for <%s> failed: expected <%s>, "
"raised <%s>")
(append '(progn) ',body)
,error-message (cdr elk-test-error))))))
(defmacro deftest (name &rest body)
"Define a test case.
Use `assert-equal', `assert-eq', `assert-eql', `assert-nonnil', `assert-t',
`assert-nil' and `assert-error' to verify the code."
`(progn (unless (gethash ,name elk-test-map)
(push ,name elk-test-list))
(puthash ,name ',body elk-test-map)
,(if elk-test-run-on-define
`(run-elk-test ',name ,t)
name)))
(defmacro defsuite (name &rest body)
"Define a test suite using a collection of `deftest' forms.
The resulting suite can be called with `run-elk-test' and parameter NAME."
`(let ((suite
(let ((elk-test-map (make-hash-table :test 'equal))
(elk-test-list nil))
,@body
(list 'suite elk-test-map (reverse elk-test-list)))))
(unless (gethash ,name elk-test-map)
(push ,name elk-test-list))
(puthash ,name suite elk-test-map)
,(if elk-test-run-on-define
`(run-elk-test ,name t)
name)))
(defun build-suite (name &rest tests)
"Define a test suite using a collection of test names.
The resulting suite can be run by calling `run-elk-test' with parameter NAME."
(unless (gethash name elk-test-map)
(push name elk-test-list))
(puthash name
(let ((map (make-hash-table :test 'equal))
(list nil))
(dolist (test-name tests)
(push test-name list)
(when (gethash test-name map)
(error "Test used twice"))
(let ((test (gethash test-name elk-test-map)))
(unless test
(error "Undefined test <%s>" test-name))
(puthash test-name test map)))
(list 'suite map (reverse list)))
elk-test-map)
(if elk-test-run-on-define
(run-elk-test "sample suite" t)
name))
(provide 'elk-test)
|
