* test/test-riece-log.el

[riece] / lisp / test / lunit.el

diff --git a/lisp/test/lunit.el b/lisp/test/lunit.el
index dbe1f74..f406032 100644 (file)
--- a/lisp/test/lunit.el
+++ b/lisp/test/lunit.el
@@ -1,6 +1,6 @@
 ;;; lunit.el --- simple testing framework for luna
 
-;; Copyright (C) 2000 Daiki Ueno.
+;; Copyright (C) 2000-2004 Daiki Ueno.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Keywords: OOP, XP
@@ -32,21 +32,17 @@
 ;; (luna-define-class silly-test-case (lunit-test-case))
 ;;
 ;; (luna-define-method test-1 ((case silly-test-case))
-;;   (lunit-assert (integerp "a")))
+;;   (lunit-assert-2 case (integerp "a")))
 ;;
 ;; (luna-define-method test-2 ((case silly-test-case))
-;;   (lunit-assert (stringp "b")))
+;;   (lunit-assert-2 case (stringp "b")))
 ;;
 ;; (with-output-to-temp-buffer "*Lunit Results*"
 ;;   (lunit (lunit-make-test-suite-from-class 'silly-test-case)))
 ;; ______________________________________________________________________
-;; Starting test `silly-test-case#test-1'
-;; failure: (integerp "a")
-;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-;; ______________________________________________________________________
-;; Starting test `silly-test-case#test-2'
-;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-;; 2 runs, 1 failures, 0 errors
+;; Running `silly-test-case#test-1'... failure: (integerp "a")
+;; Running `silly-test-case#test-2'...
+;; 2 runs, 2 assertions, 1 failures, 0 errors
 
 ;;; Code:
 
@@ -54,6 +50,8 @@
 
 (eval-when-compile (require 'cl))
 
+(require 'pp)
+
 ;;; @ test
 ;;;
 
@@ -90,7 +88,8 @@
   (luna-define-class lunit-test-result ()
                     (errors
                      failures
-                     listeners))
+                     listeners
+                     assert-count))
 
   (luna-define-internal-accessors 'lunit-test-result))
 
@@ -100,20 +99,12 @@
 (luna-define-generic lunit-test-result-notify (result message &rest args)
   "Report the current state of execution.")
 
-(luna-define-generic lunit-test-result-error (result case error)
-  "Add error to the list of errors.
-The passed in exception caused the error.")
-
-(luna-define-generic lunit-test-result-failure (result case failure)
-  "Add failure to the list of failures.
-The passed in exception caused the failure.")
-
 (luna-define-generic lunit-test-result-add-listener (result listener)
   "Add listener to the list of listeners.")
 
 (defun lunit-make-test-result (&rest listeners)
   "Return a newly allocated `lunit-test-result' instance with LISTENERS."
-  (luna-make-entity 'lunit-test-result :listeners listeners))
+  (luna-make-entity 'lunit-test-result :listeners listeners :assert-count 0))
 
 (luna-define-method lunit-test-result-notify ((result lunit-test-result)
                                              message args)
@@ -127,27 +118,25 @@ The passed in exception caused the failure.")
   (condition-case error
       (lunit-test-case-run case)
     (lunit-failure
-     (lunit-test-result-failure result case (nth 1 error)))
+     (lunit-test-result-set-failures-internal
+      result
+      (nconc (lunit-test-result-failures-internal result)
+            (list (cons case (cdr error)))))
+     (lunit-test-result-notify
+      result 'lunit-test-listener-failure case (cdr error)))
     (lunit-error
-     (lunit-test-result-error result case (cdr error))))
+     (lunit-test-result-set-errors-internal
+      result
+      (nconc (lunit-test-result-errors-internal result)
+            (list (cons case (cdr error)))))
+     (lunit-test-result-notify
+      result 'lunit-test-listener-error case (cdr error))))
+  (lunit-test-result-set-assert-count-internal
+   result
+   (+ (lunit-test-result-assert-count-internal result)
+      (lunit-test-case-assert-count-internal case)))
   (lunit-test-result-notify result 'lunit-test-listener-end case))
 
-(luna-define-method lunit-test-result-error ((result lunit-test-result)
-                                            case error)
-  (let ((errors
-        (lunit-test-result-errors-internal result)))
-    (setq errors (nconc errors (list (cons case error))))
-    (lunit-test-result-set-errors-internal result errors))
-  (lunit-test-result-notify result 'lunit-test-listener-error case error))
-
-(luna-define-method lunit-test-result-failure ((result lunit-test-result)
-                                              case failure)
-  (let ((failures
-        (lunit-test-result-failures-internal result)))
-    (setq failures (nconc failures (list (cons case failure))))
-    (lunit-test-result-set-failures-internal result failures))
-  (lunit-test-result-notify result 'lunit-test-listener-failure case failure))
-
 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
                                                    listener)
   (let ((listeners
@@ -158,7 +147,11 @@ The passed in exception caused the failure.")
 ;;; @ test case
 ;;;
 
-(luna-define-class lunit-test-case (lunit-test))
+(eval-and-compile
+  (luna-define-class lunit-test-case (lunit-test)
+                    (assert-count))
+
+  (luna-define-internal-accessors 'lunit-test-case))
 
 (luna-define-generic lunit-test-case-run (case)
   "Run the test case.")
@@ -173,7 +166,7 @@ The passed in exception caused the failure.")
   "Return a newly allocated `lunit-test-case'.
 CLASS is a symbol for class derived from `lunit-test-case'.
 NAME is name of the method to be tested."
-  (luna-make-entity class :name name))
+  (luna-make-entity class :name name :assert-count 0))
 
 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
   1)
@@ -236,8 +229,17 @@ TESTS holds a number of instances of `lunit-test'."
 
 (defmacro lunit-assert (condition-expr)
   "Verify that CONDITION-EXPR returns non-nil; signal an error if not."
-  (let ((condition (eval condition-expr)))
-    `(when ,(not condition)
+  `(unless ,condition-expr
+     (signal 'lunit-failure (list ',condition-expr))))
+
+(defmacro lunit-assert-2 (case condition-expr)
+  "In regard to CASE, verify that CONDITION-EXPR returns non-nil;
+signal an error if not."
+  `(let ((case ,case))
+     (lunit-test-case-set-assert-count-internal
+      case
+      (1+ (lunit-test-case-assert-count-internal case)))
+     (unless ,condition-expr
        (signal 'lunit-failure (list ',condition-expr)))))
 
 (luna-define-class lunit-test-printer (lunit-test-listener))
@@ -278,12 +280,15 @@ TESTS holds a number of instances of `lunit-test'."
         (result
          (lunit-make-test-result printer)))
     (lunit-test-run test result)
-    (let ((failures
+    (let ((assert-count
+          (lunit-test-result-assert-count-internal result))
+         (failures
           (lunit-test-result-failures-internal result))
          (errors
           (lunit-test-result-errors-internal result)))
-      (princ (format "%d runs, %d failures, %d errors\n"
+      (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
                     (lunit-test-number-of-tests test)
+                    assert-count
                     (length failures)
                     (length errors))))))