1 ;;; lunit.el --- simple testing framework for luna
3 ;; Copyright (C) 2000 Daiki Ueno.
5 ;; Author: Daiki Ueno <ueno@unixuser.org>
8 ;; This file is part of FLIM (Faithful Library about Internet Message).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This module is inspired by "JUnit A Cook's Tour".
28 ;; <URL:http://www.junit.org/junit/doc/cookstour/cookstour.htm>
32 ;; (luna-define-class silly-test-case (lunit-test-case))
34 ;; (luna-define-method test-1 ((case silly-test-case))
35 ;; (lunit-assert (integerp "a")))
37 ;; (luna-define-method test-2 ((case silly-test-case))
38 ;; (lunit-assert (stringp "b")))
40 ;; (with-output-to-temp-buffer "*Lunit Results*"
41 ;; (lunit (lunit-make-test-suite-from-class 'silly-test-case)))
42 ;; ______________________________________________________________________
43 ;; Starting test `silly-test-case#test-1'
44 ;; failure: (integerp "a")
45 ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 ;; ______________________________________________________________________
47 ;; Starting test `silly-test-case#test-2'
48 ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
49 ;; 2 runs, 1 failures, 0 errors
55 (eval-when-compile (require 'cl))
61 (luna-define-class lunit-test ()
64 (luna-define-internal-accessors 'lunit-test))
66 (luna-define-generic lunit-test-number-of-tests (test)
67 "Count the number of test cases that will be run by the test.")
69 (luna-define-generic lunit-test-run (test result)
70 "Run the test and collects its result in result.")
72 (luna-define-generic lunit-test-suite-add-test (suite test)
73 "Add the test to the suite.")
78 (luna-define-class lunit-test-listener ())
80 (luna-define-generic lunit-test-listener-error (listener case error)
83 (luna-define-generic lunit-test-listener-failure (listener case failure)
84 "A failure occurred.")
86 (luna-define-generic lunit-test-listener-start (listener case)
89 (luna-define-generic lunit-test-listener-end (listener case)
95 (put 'lunit-error 'error-message "test error")
96 (put 'lunit-error 'error-conditions '(lunit-error error))
98 (put 'lunit-failure 'error-message "test failure")
99 (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
102 (luna-define-class lunit-test-result ()
107 (luna-define-internal-accessors 'lunit-test-result))
109 (luna-define-generic lunit-test-result-run (result case)
110 "Run the test case.")
112 (luna-define-generic lunit-test-result-error (result case error)
113 "Add error to the list of errors.
114 The passed in exception caused the error.")
116 (luna-define-generic lunit-test-result-failure (result case failure)
117 "Add failure to the list of failures.
118 The passed in exception caused the failure.")
120 (luna-define-generic lunit-test-result-add-listener (result listener)
121 "Add listener to the list of listeners.")
123 (defun lunit-make-test-result (&rest listeners)
124 "Return a newly allocated `lunit-test-result' instance with LISTENERS."
125 (luna-make-entity 'lunit-test-result :listeners listeners))
127 (luna-define-method lunit-test-result-run ((result lunit-test-result) case)
128 (let ((listeners (lunit-test-result-listeners-internal result)))
129 (dolist (listener listeners)
130 (lunit-test-listener-start listener case))
131 (condition-case error
132 (lunit-test-case-run case)
134 (lunit-test-result-failure result case (nth 1 error)))
136 (lunit-test-result-error result case (cdr error))))
137 (dolist (listener listeners)
138 (lunit-test-listener-end listener case))))
140 (luna-define-method lunit-test-result-error ((result lunit-test-result)
142 (let ((listeners (lunit-test-result-listeners-internal result))
143 (errors (lunit-test-result-errors-internal result)))
145 (nconc errors (list (cons case error)))
146 (lunit-test-result-set-errors-internal result (list (cons case error))))
147 (dolist (listener listeners)
148 (lunit-test-listener-error listener case error))))
150 (luna-define-method lunit-test-result-failure ((result lunit-test-result)
152 (let ((listeners (lunit-test-result-listeners-internal result))
153 (failures (lunit-test-result-failures-internal result)))
155 (nconc failures (list (cons case failure)))
156 (lunit-test-result-set-failures-internal result (list (cons case failure))))
157 (dolist (listener listeners)
158 (lunit-test-listener-failure listener case failure))))
160 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
162 (let ((listeners (lunit-test-result-listeners-internal result)))
164 (nconc listeners (list listener))
165 (lunit-test-result-set-listeners-internal result (list listener)))))
170 (luna-define-class lunit-test-case (lunit-test))
172 (luna-define-generic lunit-test-case-run (case)
173 "Run the test case.")
175 (luna-define-generic lunit-test-case-setup (case)
176 "Setup the test case.")
178 (luna-define-generic lunit-test-case-teardown (case)
179 "Clear the test case.")
181 (defun lunit-make-test-case (class name)
182 "Return a newly allocated `lunit-test-case'.
183 CLASS is a symbol for class derived from `lunit-test-case'.
184 NAME is name of the method to be tested."
185 (luna-make-entity class :name name))
187 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
190 (luna-define-method lunit-test-run ((case lunit-test-case) result)
191 (lunit-test-result-run result case))
193 (luna-define-method lunit-test-case-setup ((case lunit-test-case)))
194 (luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
196 (luna-define-method lunit-test-case-run ((case lunit-test-case))
197 (lunit-test-case-setup case)
200 (lunit-test-name-internal case))
202 (luna-find-functions case name)))
204 (error "Method \"%S\" not found" name))
205 (condition-case error
206 (funcall (car functions) case)
208 (signal (car error)(cdr error)))
210 (signal 'lunit-error error))))
211 (lunit-test-case-teardown case)))
217 (luna-define-class lunit-test-suite (lunit-test)
220 (luna-define-internal-accessors 'lunit-test-suite))
222 (defun lunit-make-test-suite (&rest tests)
223 "Return a newly allocated `lunit-test-suite' instance.
224 TESTS holds a number of instances of `lunit-test'."
225 (luna-make-entity 'lunit-test-suite :tests tests))
227 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
228 (let ((tests (lunit-test-suite-tests-internal suite)))
230 (nconc tests (list test))
231 (lunit-test-suite-set-tests-internal suite (list test)))))
233 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
234 (let ((tests (lunit-test-suite-tests-internal suite))
237 (setq accu (+ accu (lunit-test-number-of-tests test))))
240 (luna-define-method lunit-test-run ((suite lunit-test-suite) result)
241 (let ((tests (lunit-test-suite-tests-internal suite)))
243 (lunit-test-run test result))))
248 (defmacro lunit-assert (condition-expr)
249 "Verify that CONDITION-EXPR returns non-nil; signal an error if not."
250 (let ((condition (eval condition-expr)))
252 (signal 'lunit-failure (list ',condition-expr)))))
254 (luna-define-class lunit-test-printer (lunit-test-listener))
256 (luna-define-method lunit-test-listener-error ((printer lunit-test-printer)
258 (princ (format " error: %S" error)))
260 (luna-define-method lunit-test-listener-failure ((printer lunit-test-printer)
262 (princ (format " failure: %S" failure)))
264 (luna-define-method lunit-test-listener-start ((printer lunit-test-printer) case)
265 (princ (format "Running `%S#%S'..."
266 (luna-class-name case)
267 (lunit-test-name-internal case))))
269 (luna-define-method lunit-test-listener-end ((printer lunit-test-printer) case)
272 (defun lunit-make-test-suite-from-class (class)
273 "Make a test suite from all test methods of the CLASS."
277 (if (and (fboundp symbol)
278 (null (get symbol 'luna-method-qualifier)))
279 (push (lunit-make-test-case class symbol) tests)))
280 (luna-class-obarray (luna-find-class class)))
281 (apply #'lunit-make-test-suite tests)))
284 "Run TEST and display the result."
286 (luna-make-entity 'lunit-test-printer))
288 (lunit-make-test-result printer))
291 (lunit-test-run test result)
292 (setq failures (lunit-test-result-failures-internal result)
293 errors (lunit-test-result-errors-internal result))
294 (princ (format "%d runs, %d failures, %d errors\n"
295 (lunit-test-number-of-tests test)
301 ;;; lunit.el ends here