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))
59 (luna-define-class lunit-test ()
62 (luna-define-internal-accessors 'lunit-test))
64 (luna-define-generic lunit-test-number-of-tests (test)
65 "Count the number of test cases that will be run by the test.")
67 (luna-define-generic lunit-test-run (test result)
68 "Run the test and collects its result in result.")
70 (luna-define-generic lunit-test-suite-add-test (suite test)
71 "Add the test to the suite.")
76 (luna-define-class lunit-test-listener)
81 (put 'lunit-error 'error-message "test error")
82 (put 'lunit-error 'error-conditions '(lunit-error error))
84 (put 'lunit-failure 'error-message "test failure")
85 (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
88 (luna-define-class lunit-test-result ()
94 (luna-define-internal-accessors 'lunit-test-result))
96 (luna-define-generic lunit-test-result-run (result case)
99 (luna-define-generic lunit-test-result-notify (result message &rest args)
100 "Report the current state of execution.")
102 (luna-define-generic lunit-test-result-add-listener (result listener)
103 "Add listener to the list of listeners.")
105 (defun lunit-make-test-result (&rest listeners)
106 "Return a newly allocated `lunit-test-result' instance with LISTENERS."
107 (luna-make-entity 'lunit-test-result :listeners listeners :assert-count 0))
109 (luna-define-method lunit-test-result-notify ((result lunit-test-result)
112 (lunit-test-result-listeners-internal result)))
113 (dolist (listener listeners)
114 (apply #'luna-send listener message listener args))))
116 (luna-define-method lunit-test-result-run ((result lunit-test-result) case)
117 (lunit-test-result-notify result 'lunit-test-listener-start case)
118 (condition-case error
119 (lunit-test-case-run case)
121 (lunit-test-result-set-failures-internal
123 (nconc (lunit-test-result-failures-internal result)
124 (list (cons case (cdr error)))))
125 (lunit-test-result-notify
126 result 'lunit-test-listener-failure case (cdr error)))
128 (lunit-test-result-set-errors-internal
130 (nconc (lunit-test-result-errors-internal result)
131 (list (cons case (cdr error)))))
132 (lunit-test-result-notify
133 result 'lunit-test-listener-error case (cdr error))))
134 (lunit-test-result-set-assert-count-internal
136 (+ (lunit-test-result-assert-count-internal result)
137 (lunit-test-case-assert-count-internal case)))
138 (lunit-test-result-notify result 'lunit-test-listener-end case))
140 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
143 (lunit-test-result-listeners-internal result)))
144 (setq listeners (nconc listeners (list listener)))
145 (lunit-test-result-set-listeners-internal result listeners)))
151 (luna-define-class lunit-test-case (lunit-test)
154 (luna-define-internal-accessors 'lunit-test-case))
156 (luna-define-generic lunit-test-case-run (case)
157 "Run the test case.")
159 (luna-define-generic lunit-test-case-setup (case)
160 "Setup the test case.")
162 (luna-define-generic lunit-test-case-teardown (case)
163 "Clear the test case.")
165 (defun lunit-make-test-case (class name)
166 "Return a newly allocated `lunit-test-case'.
167 CLASS is a symbol for class derived from `lunit-test-case'.
168 NAME is name of the method to be tested."
169 (luna-make-entity class :name name :assert-count 0))
171 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
174 (luna-define-method lunit-test-run ((case lunit-test-case) result)
175 (lunit-test-result-run result case))
177 (luna-define-method lunit-test-case-setup ((case lunit-test-case)))
178 (luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
180 (luna-define-method lunit-test-case-run ((case lunit-test-case))
181 (lunit-test-case-setup case)
184 (lunit-test-name-internal case))
186 (luna-find-functions case name)))
188 (error "Method \"%S\" not found" name))
189 (condition-case error
190 (funcall (car functions) case)
192 (signal (car error)(cdr error)))
194 (signal 'lunit-error error))))
195 (lunit-test-case-teardown case)))
201 (luna-define-class lunit-test-suite (lunit-test)
204 (luna-define-internal-accessors 'lunit-test-suite))
206 (defun lunit-make-test-suite (&rest tests)
207 "Return a newly allocated `lunit-test-suite' instance.
208 TESTS holds a number of instances of `lunit-test'."
209 (luna-make-entity 'lunit-test-suite :tests tests))
211 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
212 (let ((tests (lunit-test-suite-tests-internal suite)))
213 (lunit-test-suite-set-tests-internal suite (nconc tests (list test)))))
215 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
216 (let ((tests (lunit-test-suite-tests-internal suite))
219 (setq accu (+ accu (lunit-test-number-of-tests test))))
222 (luna-define-method lunit-test-run ((suite lunit-test-suite) result)
223 (let ((tests (lunit-test-suite-tests-internal suite)))
225 (lunit-test-run test result))))
230 (defmacro lunit-assert (condition-expr)
231 "Verify that CONDITION-EXPR returns non-nil; signal an error if not."
232 `(unless ,condition-expr
233 (signal 'lunit-failure (list ',condition-expr))))
235 (defmacro lunit-assert-2 (case condition-expr)
236 "In regard to CASE, verify that CONDITION-EXPR returns non-nil;
237 signal an error if not."
239 (lunit-test-case-set-assert-count-internal
241 (1+ (lunit-test-case-assert-count-internal case)))
242 (unless ,condition-expr
243 (signal 'lunit-failure (list ',condition-expr)))))
245 (luna-define-class lunit-test-printer (lunit-test-listener))
247 (luna-define-method lunit-test-listener-error ((printer lunit-test-printer)
249 (princ (format " error: %S" error)))
251 (luna-define-method lunit-test-listener-failure ((printer lunit-test-printer)
253 (princ (format " failure: %S" failure)))
255 (luna-define-method lunit-test-listener-start ((printer lunit-test-printer)
257 (princ (format "Running `%S#%S'..."
258 (luna-class-name case)
259 (lunit-test-name-internal case))))
261 (luna-define-method lunit-test-listener-end ((printer lunit-test-printer) case)
264 (defun lunit-make-test-suite-from-class (class)
265 "Make a test suite from all test methods of the CLASS."
269 (if (and (fboundp symbol)
270 (string-match "^test" (symbol-name symbol))
271 (null (get symbol 'luna-method-qualifier)))
272 (push (lunit-make-test-case class symbol) tests)))
273 (luna-class-obarray (luna-find-class class)))
274 (apply #'lunit-make-test-suite tests)))
277 "Run TEST and display the result."
279 (luna-make-entity 'lunit-test-printer))
281 (lunit-make-test-result printer)))
282 (lunit-test-run test result)
284 (lunit-test-result-assert-count-internal result))
286 (lunit-test-result-failures-internal result))
288 (lunit-test-result-errors-internal result)))
289 (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
290 (lunit-test-number-of-tests test)
295 ;; stolen (and renamed) from time-date.el.
296 (defun lunit-time-since (time)
297 "Return the time elapsed since TIME."
298 (let* ((current (current-time))
299 (rest (when (< (nth 1 current) (nth 1 time))
301 (list (- (+ (car current) (if rest -1 0)) (car time))
302 (- (+ (or rest 0) (nth 1 current)) (nth 1 time))
303 (- (nth 2 current) (nth 2 time)))))
306 (luna-define-class lunit-test-reporter (lunit-test-listener)
310 (luna-define-internal-accessors 'lunit-test-reporter))
312 (defun lunit-escape-quote (string)
314 (while (string-match "\"" string index)
315 (setq string (replace-match """ nil t string)
319 (luna-define-method lunit-test-listener-error ((reporter lunit-test-reporter)
322 (set-buffer (lunit-test-reporter-buffer-internal reporter))
324 <error message=\"%s\" type=\"error\"/>
326 (lunit-escape-quote (pp-to-string error))))))
328 (luna-define-method lunit-test-listener-failure ((reporter lunit-test-reporter)
331 (set-buffer (lunit-test-reporter-buffer-internal reporter))
333 <failure message=\"%s\" type=\"failure\"/>
335 (lunit-escape-quote (pp-to-string failure))))))
337 (luna-define-method lunit-test-listener-start ((reporter lunit-test-reporter)
340 (set-buffer (lunit-test-reporter-buffer-internal reporter))
341 (goto-char (point-max))
342 (narrow-to-region (point) (point))
344 <testcase name=\"%s\" classname=\"%s\">
346 (lunit-test-name-internal case)
347 (luna-class-name case)))
348 (lunit-test-reporter-set-start-time-internal reporter (current-time))))
350 (luna-define-method lunit-test-listener-end ((reporter lunit-test-reporter)
354 (lunit-test-reporter-start-time-internal reporter))))
356 (set-buffer (lunit-test-reporter-buffer-internal reporter))
361 (goto-char (point-min))
362 (looking-at " *<testcase\\>")
363 (goto-char (match-end 0))
364 (insert (format " time=\"%.03f\" "
366 (/ (nth 2 elapsed) 1000000.0))))
369 (defun lunit-report (test)
370 "Run TEST and output result as XML."
372 (luna-make-entity 'lunit-test-printer))
374 (lunit-make-test-result printer))
375 (buffer (find-file-noselect "lunit-report.xml"))
380 (lunit-test-result-add-listener
382 (luna-make-entity 'lunit-test-reporter :buffer buffer))
383 (setq start-time (current-time))
384 (lunit-test-run test result)
386 (lunit-test-result-assert-count-internal result))
388 (lunit-test-result-failures-internal result))
390 (lunit-test-result-errors-internal result))
392 (elapsed (lunit-time-since start-time)))
393 (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
394 (lunit-test-number-of-tests test)
400 (goto-char (point-min))
402 <?xml version=\"1.0\" encoding=\"UTF-8\"?>
404 <testsuite name=\"\" tests=\"%d\" failures=\"%d\" \
405 errors=\"%d\" time =\"%.03f\">
407 <property name=\"emacs-version\" value=\"%s\"/>
410 (lunit-test-number-of-tests test)
414 (/ (nth 2 elapsed) 1000000.0))
415 (lunit-escape-quote (emacs-version))))
416 (goto-char (point-max))
423 (defvar imenu-create-index-function)
424 (defun lunit-create-index-function ()
429 (goto-char (point-min))
430 (setq imenu-generic-expression
431 '((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)))
432 (funcall imenu-create-index-function))
433 (setq imenu-create-index-function lisp-imenu-generic-expression))))
435 (defun lunit-generate-template (file)
436 (interactive "fGenerate lunit template for: ")
438 (set-buffer (find-file-noselect file))
440 (lunit-create-index-function)))
441 (with-output-to-temp-buffer "*Lunit template*"
443 (file-name-sans-extension
444 (file-name-nondirectory file)))
446 (concat "test-" feature)))
447 (set-buffer standard-output)
450 \(require '" feature ")
452 \(luna-define-class " class " (lunit-test-case))
455 (dolist (index index-alist)
457 \(luna-define-method " class "-" (car index) " ((case " class "))
464 ;;; lunit.el ends here