From: ueno <ueno>
Date: Fri, 26 Nov 2004 07:33:35 +0000 (+0000)
Subject: * COMPILE (riece-test): Require 'lunit after when ./test is added
X-Git-Tag: riece-1_0_6~20
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2bddfd6c3a8c7ba5eded2098ee2ce45101c551e1;p=elisp%2Friece.git

* COMPILE (riece-test): Require 'lunit after when ./test is added
to load-path.

* test/test-riece-yank.el (test-riece-yank-strip-space): Use
lunit-assert-2 instead of lunit-assert.

* test/test-riece-url.el (test-riece-url-replace-match): Use
lunit-assert-2 instead of lunit-assert.
(test-riece-url-regexp-alist): Ditto.

* test/test-riece-alias.el (test-riece-alias-percent-hack): Use
lunit-assert-2 instead of lunit-assert.
(test-riece-alias-alist-1): Ditto.
(test-riece-alias-alist-2): Ditto.
(test-riece-alias-altsep-1): Ditto.
(test-riece-alias-altsep-2): Ditto.
(test-riece-alias-altsep-3): Ditto.
(test-riece-alias-altsep-4): Ditto.

* test/test-riece-addon.el (test-riece-resolve-addons-1): Use
lunit-assert-2 instead of lunit-assert.
(test-riece-resolve-addons-2): Ditto.

* test/lunit.el: Don't treat a failure as an Emacs error signal;
count assertions in test-case methods.
(lunit-test-result): Add assert-count slot.
(lunit-make-test-result): Reset assert-count to 0.
(lunit-test-result-run): Count assertions; collect failures at a
time after test-case execution.
(lunit-test-result-failure): Abolished.
(lunit-test-case): Add failures and assert-count slots; define
internal accesssors for them.
(lunit-make-test-case): Reset assert-count to 0.
(lunit-test-case-run): Don't handle failure signals.
(lunit-assert): Define as a nop macro.
(lunit-assert-2): New macro.  Use this instead of lunit-assert.
(lunit): Display assertion count.
---

diff --git a/lisp/COMPILE b/lisp/COMPILE
index 518ab57..0c45e4a 100644
--- a/lisp/COMPILE
+++ b/lisp/COMPILE
@@ -138,10 +138,11 @@
    (riece-install-just-print-p)))
 
 (defun riece-test ()
-  (require 'lunit)
   (let ((load-path (cons (expand-file-name "test") (cons nil load-path)))
 	(files (directory-files "test" t "^test-.*\\.el$"))
-        (suite (lunit-make-test-suite)))
+        suite)
+    (require 'lunit)
+    (setq suite (lunit-make-test-suite))
     (while files
       (when (file-regular-p (car files))
 	(load-file (car files))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fd54aff..9f4b9aa 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,43 @@
+2004-11-26  Daiki Ueno  <ueno@unixuser.org>
+
+	* COMPILE (riece-test): Require 'lunit after when ./test is added
+	to load-path.
+
+	* test/test-riece-yank.el (test-riece-yank-strip-space): Use
+	lunit-assert-2 instead of lunit-assert.
+
+	* test/test-riece-url.el (test-riece-url-replace-match): Use
+	lunit-assert-2 instead of lunit-assert.
+	(test-riece-url-regexp-alist): Ditto.
+
+	* test/test-riece-alias.el (test-riece-alias-percent-hack): Use
+	lunit-assert-2 instead of lunit-assert.
+	(test-riece-alias-alist-1): Ditto.
+	(test-riece-alias-alist-2): Ditto.
+	(test-riece-alias-altsep-1): Ditto.
+	(test-riece-alias-altsep-2): Ditto.
+	(test-riece-alias-altsep-3): Ditto.
+	(test-riece-alias-altsep-4): Ditto.
+
+	* test/test-riece-addon.el (test-riece-resolve-addons-1): Use
+	lunit-assert-2 instead of lunit-assert.
+	(test-riece-resolve-addons-2): Ditto.
+
+	* test/lunit.el: Don't treat a failure as an Emacs error signal;
+	count assertions in test-case methods.
+	(lunit-test-result): Add assert-count slot.
+	(lunit-make-test-result): Reset assert-count to 0.
+	(lunit-test-result-run): Count assertions; collect failures at a
+	time after test-case execution.
+	(lunit-test-result-failure): Abolished.
+	(lunit-test-case): Add failures and assert-count slots; define
+	internal accesssors for them.
+	(lunit-make-test-case): Reset assert-count to 0.
+	(lunit-test-case-run): Don't handle failure signals.
+	(lunit-assert): Define as a nop macro.
+	(lunit-assert-2): New macro.  Use this instead of lunit-assert.
+	(lunit): Display assertion count.
+
 2004-11-25  Daiki Ueno  <ueno@unixuser.org>
 
 	* Makefile.am (EXTRA_DIST): Add url-riece.el.
diff --git a/lisp/test/lunit.el b/lisp/test/lunit.el
index dbe1f74..12120a8 100644
--- a/lisp/test/lunit.el
+++ b/lisp/test/lunit.el
@@ -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:
 
@@ -83,14 +79,12 @@
 (put 'lunit-error 'error-message "test error")
 (put 'lunit-error 'error-conditions '(lunit-error error))
 
-(put 'lunit-failure 'error-message "test failure")
-(put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
-
 (eval-and-compile
   (luna-define-class lunit-test-result ()
 		     (errors
 		      failures
-		      listeners))
+		      listeners
+		      assert-count))
 
   (luna-define-internal-accessors 'lunit-test-result))
 
@@ -101,19 +95,14 @@
   "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.")
+  "Add error to the list of errors.")
 
 (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)
@@ -126,10 +115,24 @@ The passed in exception caused the failure.")
   (lunit-test-result-notify result 'lunit-test-listener-start case)
   (condition-case error
       (lunit-test-case-run case)
-    (lunit-failure
-     (lunit-test-result-failure result case (nth 1 error)))
     (lunit-error
      (lunit-test-result-error result 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)))
+  (let ((failures
+	 (lunit-test-case-failures-internal case)))
+    (when failures
+      (lunit-test-result-set-failures-internal
+       result
+       (nconc (lunit-test-result-failures-internal result)
+	      (mapcar (lambda (failure)
+			(prog1 (cons case failure)
+			  (lunit-test-result-notify
+			   result 'lunit-test-listener-failure
+			   case failure)))
+		      failures)))))
   (lunit-test-result-notify result 'lunit-test-listener-end case))
 
 (luna-define-method lunit-test-result-error ((result lunit-test-result)
@@ -140,14 +143,6 @@ The passed in exception caused the failure.")
     (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 +153,12 @@ 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)
+		     (failures
+		      assert-count))
+
+  (luna-define-internal-accessors 'lunit-test-case))
 
 (luna-define-generic lunit-test-case-run (case)
   "Run the test case.")
@@ -173,7 +173,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)
@@ -195,8 +195,6 @@ NAME is name of the method to be tested."
 	  (error "Method \"%S\" not found" name))
 	(condition-case error
 	    (funcall (car functions) case)
-	  (lunit-failure
-	   (signal (car error)(cdr error)))
 	  (error
 	   (signal 'lunit-error error))))
     (lunit-test-case-teardown case)))
@@ -236,9 +234,20 @@ 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)
-       (signal 'lunit-failure (list ',condition-expr)))))
+  (princ "`lunit-assert' is obsolete; use `lunit-assert-2' instead.\n"))
+
+(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
+       (lunit-test-case-set-failures-internal
+	case
+	(cons ',condition-expr
+	      (lunit-test-case-failures-internal case))))))
 
 (luna-define-class lunit-test-printer (lunit-test-listener))
 
@@ -278,12 +287,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))))))
 
diff --git a/lisp/test/test-riece-addon.el b/lisp/test/test-riece-addon.el
index ba385d1..b0e39b1 100644
--- a/lisp/test/test-riece-addon.el
+++ b/lisp/test/test-riece-addon.el
@@ -25,14 +25,16 @@
 (luna-define-class test-riece-addon (lunit-test-case))
 
 (luna-define-method test-riece-resolve-addons-1 ((case test-riece-addon))
-  (lunit-assert
+  (lunit-assert-2
+   case
    (equal
     (riece-resolve-addons '(test-riece-addon-1 test-riece-addon-2))
     '(test-riece-addon-3 test-riece-addon-4
 			 test-riece-addon-2 test-riece-addon-1))))
 
 (luna-define-method test-riece-resolve-addons-2 ((case test-riece-addon))
-  (lunit-assert
+  (lunit-assert-2
+   case
    (equal
     (condition-case error
 	(riece-resolve-addons '(test-riece-addon-5 test-riece-addon-6))
diff --git a/lisp/test/test-riece-alias.el b/lisp/test/test-riece-alias.el
index a2da219..fe27205 100644
--- a/lisp/test/test-riece-alias.el
+++ b/lisp/test/test-riece-alias.el
@@ -4,22 +4,26 @@
 
 (luna-define-method test-riece-alias-percent-hack ((case test-riece-alias))
   (let ((riece-alias-percent-hack-mask "*.jp"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-percent-hack "#riece:*.jp")
       "%riece"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-percent-hack "%riece")
       "#riece:*.jp"))))
 
 (luna-define-method test-riece-alias-alist-1 ((case test-riece-alias))
   (let ((riece-alias-alist '(("#riece" . "#r"))))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-identity-string "#riece")
       "#r"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-identity-string "#r")
       "#riece"))))
@@ -27,87 +31,105 @@
 (luna-define-method test-riece-alias-alist-2 ((case test-riece-alias))
   (let ((riece-alias-alist '(("%riece" . "%r")))
 	(riece-alias-percent-hack-mask "*.jp"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-identity-string "#riece:*.jp")
       "%r"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-identity-string "%r")
       "#riece:*.jp"))))
 
 (luna-define-method test-riece-alias-altsep-1 ((case test-riece-alias))
   (let ((riece-alias-alternate-separator "@"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#riece")
       "#riece"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#riece localhost")
       "#riece@localhost"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#ch@nnel")
       "#ch@@nnel"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#ch@nnel localhost")
       "#ch@@nnel@localhost"))))
 
 (luna-define-method test-riece-alias-altsep-2 ((case test-riece-alias))
   (let ((riece-alias-alternate-separator "@@"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#riece")
       "#riece"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#riece localhost")
       "#riece@@localhost"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#ch@@nnel")
       "#ch@@@@nnel"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-abbrev-alternate-separator "#ch@@nnel localhost")
       "#ch@@@@nnel@@localhost"))))
 
 (luna-define-method test-riece-alias-altsep-3 ((case test-riece-alias))
   (let ((riece-alias-alternate-separator "@"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#riece")
       "#riece"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#riece@localhost")
       "#riece localhost"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#ch@@nnel")
       "#ch@nnel"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#ch@@nnel@localhost")
       "#ch@nnel localhost"))))
 
 (luna-define-method test-riece-alias-altsep-4 ((case test-riece-alias))
   (let ((riece-alias-alternate-separator "@@"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#riece")
       "#riece"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#riece@@localhost")
       "#riece localhost"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#ch@@@@nnel")
       "#ch@@nnel"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal
       (riece-alias-expand-alternate-separator "#ch@@@@nnel@@localhost")
       "#ch@@nnel localhost"))))
\ No newline at end of file
diff --git a/lisp/test/test-riece-url.el b/lisp/test/test-riece-url.el
index a76a2e8..d5defe3 100644
--- a/lisp/test/test-riece-url.el
+++ b/lisp/test/test-riece-url.el
@@ -7,19 +7,23 @@
     (insert "111\n222\n333\n")
     (goto-char (point-min))
     (re-search-forward "2\\(2\\)2")
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal (save-match-data
 	      (riece-url-replace-match "\\&"))
 	    "222"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal (save-match-data
 	      (riece-url-replace-match "\\0"))
 	    "\\0"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal (save-match-data
 	      (riece-url-replace-match "\\1"))
 	    "2"))
-    (lunit-assert
+    (lunit-assert-2
+     case
      (equal (save-match-data
 	      (riece-url-replace-match "\\\\"))
 	    "\\"))))
@@ -33,5 +37,6 @@
 	  riece-urls
 	  riece-addons)
       (riece-url-scan-region (point-min) (point-max))
-      (lunit-assert
+      (lunit-assert-2
+       case
        (member "http://bugs.debian.org/12345" riece-urls)))))
diff --git a/lisp/test/test-riece-yank.el b/lisp/test/test-riece-yank.el
index f41dcc1..6039bad 100644
--- a/lisp/test/test-riece-yank.el
+++ b/lisp/test/test-riece-yank.el
@@ -3,7 +3,8 @@
 (luna-define-class test-riece-yank (lunit-test-case))
 
 (luna-define-method test-riece-yank-strip-space ((case test-riece-yank))
-  (lunit-assert
+  (lunit-assert-2
+   case
    (equal
     (riece-yank-strip-space "\
   def a