1 ;;; lunit.el --- simple testing framework for luna
3 ;; Copyright (C) 2000-2004 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-2 case (integerp "a")))
37 ;; (luna-define-method test-2 ((case silly-test-case))
38 ;; (lunit-assert-2 case (stringp "b")))
40 ;; (with-output-to-temp-buffer "*Lunit Results*"
41 ;; (lunit (lunit-make-test-suite-from-class 'silly-test-case)))
42 ;; ______________________________________________________________________
43 ;; Running `silly-test-case#test-1'... failure: (integerp "a")
44 ;; Running `silly-test-case#test-2'...
45 ;; 2 runs, 2 assertions, 1 failures, 0 errors
51 (eval-when-compile (require 'cl))
57 (luna-define-class lunit-test ()
60 (luna-define-internal-accessors 'lunit-test))
62 (luna-define-generic lunit-test-number-of-tests (test)
63 "Count the number of test cases that will be run by the test.")
65 (luna-define-generic lunit-test-run (test result)
66 "Run the test and collects its result in result.")
68 (luna-define-generic lunit-test-suite-add-test (suite test)
69 "Add the test to the suite.")
74 (luna-define-class lunit-test-listener)
79 (put 'lunit-error 'error-message "test error")
80 (put 'lunit-error 'error-conditions '(lunit-error error))
82 (put 'lunit-failure 'error-message "test failure")
83 (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
86 (luna-define-class lunit-test-result ()
92 (luna-define-internal-accessors 'lunit-test-result))
94 (luna-define-generic lunit-test-result-run (result case)
97 (luna-define-generic lunit-test-result-notify (result message &rest args)
98 "Report the current state of execution.")
100 (luna-define-generic lunit-test-result-add-listener (result listener)
101 "Add listener to the list of listeners.")
103 (defun lunit-make-test-result (&rest listeners)
104 "Return a newly allocated `lunit-test-result' instance with LISTENERS."
105 (luna-make-entity 'lunit-test-result :listeners listeners :assert-count 0))
107 (luna-define-method lunit-test-result-notify ((result lunit-test-result)
110 (lunit-test-result-listeners-internal result)))
111 (dolist (listener listeners)
112 (apply #'luna-send listener message listener args))))
114 (luna-define-method lunit-test-result-run ((result lunit-test-result) case)
115 (lunit-test-result-notify result 'lunit-test-listener-start case)
116 (condition-case error
117 (lunit-test-case-run case)
119 (lunit-test-result-set-failures-internal
121 (nconc (lunit-test-result-failures-internal result)
122 (list (cons case (cdr error)))))
123 (lunit-test-result-notify
124 result 'lunit-test-listener-failure case (cdr error)))
126 (lunit-test-result-set-errors-internal
128 (nconc (lunit-test-result-errors-internal result)
129 (list (cons case (cdr error)))))
130 (lunit-test-result-notify
131 result 'lunit-test-listener-error case (cdr error))))
132 (lunit-test-result-set-assert-count-internal
134 (+ (lunit-test-result-assert-count-internal result)
135 (lunit-test-case-assert-count-internal case)))
136 (lunit-test-result-notify result 'lunit-test-listener-end case))
138 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
141 (lunit-test-result-listeners-internal result)))
142 (setq listeners (nconc listeners (list listener)))
143 (lunit-test-result-set-listeners-internal result listeners)))
149 (luna-define-class lunit-test-case (lunit-test)
152 (luna-define-internal-accessors 'lunit-test-case))
154 (luna-define-generic lunit-test-case-run (case)
155 "Run the test case.")
157 (luna-define-generic lunit-test-case-setup (case)
158 "Setup the test case.")
160 (luna-define-generic lunit-test-case-teardown (case)
161 "Clear the test case.")
163 (defun lunit-make-test-case (class name)
164 "Return a newly allocated `lunit-test-case'.
165 CLASS is a symbol for class derived from `lunit-test-case'.
166 NAME is name of the method to be tested."
167 (luna-make-entity class :name name :assert-count 0))
169 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
172 (luna-define-method lunit-test-run ((case lunit-test-case) result)
173 (lunit-test-result-run result case))
175 (luna-define-method lunit-test-case-setup ((case lunit-test-case)))
176 (luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
178 (luna-define-method lunit-test-case-run ((case lunit-test-case))
179 (lunit-test-case-setup case)
182 (lunit-test-name-internal case))
184 (luna-find-functions case name)))
186 (error "Method \"%S\" not found" name))
187 (condition-case error
188 (funcall (car functions) case)
190 (signal (car error)(cdr error)))
192 (signal 'lunit-error error))))
193 (lunit-test-case-teardown case)))
199 (luna-define-class lunit-test-suite (lunit-test)
202 (luna-define-internal-accessors 'lunit-test-suite))
204 (defun lunit-make-test-suite (&rest tests)
205 "Return a newly allocated `lunit-test-suite' instance.
206 TESTS holds a number of instances of `lunit-test'."
207 (luna-make-entity 'lunit-test-suite :tests tests))
209 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
210 (let ((tests (lunit-test-suite-tests-internal suite)))
211 (lunit-test-suite-set-tests-internal suite (nconc tests (list test)))))
213 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
214 (let ((tests (lunit-test-suite-tests-internal suite))
217 (setq accu (+ accu (lunit-test-number-of-tests test))))
220 (luna-define-method lunit-test-run ((suite lunit-test-suite) result)
221 (let ((tests (lunit-test-suite-tests-internal suite)))
223 (lunit-test-run test result))))
228 (defmacro lunit-assert (condition-expr)
229 "Verify that CONDITION-EXPR returns non-nil; signal an error if not."
230 `(unless ,condition-expr
231 (signal 'lunit-failure (list ',condition-expr))))
233 (defmacro lunit-assert-2 (case condition-expr)
234 "In regard to CASE, verify that CONDITION-EXPR returns non-nil;
235 signal an error if not."
237 (lunit-test-case-set-assert-count-internal
239 (1+ (lunit-test-case-assert-count-internal case)))
240 (unless ,condition-expr
241 (signal 'lunit-failure (list ',condition-expr)))))
243 (luna-define-class lunit-test-printer (lunit-test-listener))
245 (luna-define-method lunit-test-listener-error ((printer lunit-test-printer)
247 (princ (format " error: %S" error)))
249 (luna-define-method lunit-test-listener-failure ((printer lunit-test-printer)
251 (princ (format " failure: %S" failure)))
253 (luna-define-method lunit-test-listener-start ((printer lunit-test-printer)
255 (princ (format "Running `%S#%S'..."
256 (luna-class-name case)
257 (lunit-test-name-internal case))))
259 (luna-define-method lunit-test-listener-end ((printer lunit-test-printer) case)
262 (defun lunit-make-test-suite-from-class (class)
263 "Make a test suite from all test methods of the CLASS."
267 (if (and (fboundp symbol)
268 (string-match "^test" (symbol-name symbol))
269 (null (get symbol 'luna-method-qualifier)))
270 (push (lunit-make-test-case class symbol) tests)))
271 (luna-class-obarray (luna-find-class class)))
272 (apply #'lunit-make-test-suite tests)))
275 "Run TEST and display the result."
277 (luna-make-entity 'lunit-test-printer))
279 (lunit-make-test-result printer)))
280 (lunit-test-run test result)
282 (lunit-test-result-assert-count-internal result))
284 (lunit-test-result-failures-internal result))
286 (lunit-test-result-errors-internal result)))
287 (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
288 (lunit-test-number-of-tests test)
293 ;; stolen (and renamed) from time-date.el.
294 (defun lunit-time-since (time)
295 "Return the time elapsed since TIME."
296 (let* ((current (current-time))
297 (rest (when (< (nth 1 current) (nth 1 time))
299 (list (- (+ (car current) (if rest -1 0)) (car time))
300 (- (+ (or rest 0) (nth 1 current)) (nth 1 time))
301 (- (nth 2 current) (nth 2 time)))))
304 (luna-define-class lunit-test-reporter (lunit-test-listener)
308 (luna-define-internal-accessors 'lunit-test-reporter))
310 (defun lunit-test-reporter-format-sexp (sexp)
312 (insert (pp-to-string sexp))
313 (goto-char (point-min))
314 (while (re-search-forward "\\\\" nil t)
315 (replace-match "\\\\" nil t))
316 (goto-char (point-min))
317 (while (re-search-forward "\"" nil t)
318 (replace-match """ nil t))
321 (luna-define-method lunit-test-listener-error ((reporter lunit-test-reporter)
324 (set-buffer (lunit-test-reporter-buffer-internal reporter))
326 <error message=\"%s\" type=\"error\"/>
328 (lunit-test-reporter-format-sexp error)))))
330 (luna-define-method lunit-test-listener-failure ((reporter lunit-test-reporter)
333 (set-buffer (lunit-test-reporter-buffer-internal reporter))
335 <failure message=\"%s\" type=\"failure\"/>
337 (lunit-test-reporter-format-sexp failure)))))
339 (luna-define-method lunit-test-listener-start ((reporter lunit-test-reporter)
342 (set-buffer (lunit-test-reporter-buffer-internal reporter))
343 (goto-char (point-max))
344 (narrow-to-region (point) (point))
346 <testcase name=\"%s\" classname=\"%s\">
348 (lunit-test-name-internal case)
349 (luna-class-name case)))
350 (lunit-test-reporter-set-start-time-internal reporter (current-time))))
352 (luna-define-method lunit-test-listener-end ((reporter lunit-test-reporter)
356 (lunit-test-reporter-start-time-internal reporter))))
358 (set-buffer (lunit-test-reporter-buffer-internal reporter))
363 (goto-char (point-min))
364 (looking-at " *<testcase\\>")
365 (goto-char (match-end 0))
366 (insert (format " time=\"%.03f\" "
368 (/ (nth 2 elapsed) 1000000.0))))
371 (defun lunit-report (test)
372 "Run TEST and output result as XML."
374 (luna-make-entity 'lunit-test-printer))
376 (lunit-make-test-result printer))
377 (buffer (find-file-noselect "lunit-report.xml"))
382 (lunit-test-result-add-listener
384 (luna-make-entity 'lunit-test-reporter :buffer buffer))
385 (setq start-time (current-time))
386 (lunit-test-run test result)
388 (lunit-test-result-assert-count-internal result))
390 (lunit-test-result-failures-internal result))
392 (lunit-test-result-errors-internal result))
394 (elapsed (lunit-time-since start-time)))
395 (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
396 (lunit-test-number-of-tests test)
402 (goto-char (point-min))
404 <?xml version=\"1.0\" encoding=\"UTF-8\"?>
406 <testsuite name=\"\" tests=\"%d\" failures=\"%d\" \
407 errors=\"%d\" time =\"%.03f\">
409 (lunit-test-number-of-tests test)
413 (/ (nth 2 elapsed) 1000000.0))))
414 (goto-char (point-max))
421 (defvar imenu-create-index-function)
422 (defun lunit-create-index-function ()
427 (goto-char (point-min))
428 (setq imenu-generic-expression
429 '((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)))
430 (funcall imenu-create-index-function))
431 (setq imenu-create-index-function lisp-imenu-generic-expression))))
433 (defun lunit-generate-template (file)
434 (interactive "fGenerate lunit template for: ")
436 (set-buffer (find-file-noselect file))
438 (lunit-create-index-function)))
439 (with-output-to-temp-buffer "*Lunit template*"
441 (file-name-sans-extension
442 (file-name-nondirectory file)))
444 (concat "test-" feature)))
445 (set-buffer standard-output)
448 \(require '" feature ")
450 \(luna-define-class " class " (lunit-test-case))
453 (dolist (index index-alist)
455 \(luna-define-method " class "-" (car index) " ((case " class "))
462 ;;; lunit.el ends here