X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lunit.el;h=0d5749ace0520aa2a7e4cf8be6017e19e1f7b236;hb=a9a2810b39be533b0df9d1fc3732b2b5cb35fcd0;hp=8f5c6e70af5e8435c1e5af0c8173ae07fbba244b;hpb=48f7f1e2c900582d0243f1087101308166bb23be;p=elisp%2Fflim.git

diff --git a/lunit.el b/lunit.el
index 8f5c6e7..0d5749a 100644
--- a/lunit.el
+++ b/lunit.el
@@ -19,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -75,19 +75,7 @@
 ;;; @ test listener
 ;;;
 
-(luna-define-class lunit-test-listener ())
-
-(luna-define-generic lunit-test-listener-error (listener case error)
-  "An error occurred.")
-
-(luna-define-generic lunit-test-listener-failure (listener case failure)
-  "A failure occurred.")
-
-(luna-define-generic lunit-test-listener-start (listener case)
-  "A test started.")
-
-(luna-define-generic lunit-test-listener-end (listener case)
-  "A test ended.")
+(luna-define-class lunit-test-listener)
 
 ;;; @ test result
 ;;;
@@ -109,6 +97,9 @@
 (luna-define-generic lunit-test-result-run (result case)
   "Run the test case.")
 
+(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.")
@@ -124,45 +115,45 @@ The passed in exception caused the failure.")
   "Return a newly allocated `lunit-test-result' instance with LISTENERS."
   (luna-make-entity 'lunit-test-result :listeners listeners))
 
-(luna-define-method lunit-test-result-run ((result lunit-test-result) case)
-  (let ((listeners (lunit-test-result-listeners-internal result)))
+(luna-define-method lunit-test-result-notify ((result lunit-test-result)
+					      message args)
+  (let ((listeners
+	 (lunit-test-result-listeners-internal result)))
     (dolist (listener listeners)
-      (lunit-test-listener-start listener 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))))
-    (dolist (listener listeners)
-      (lunit-test-listener-end listener case))))
+      (apply #'luna-send listener message listener args))))
+
+(luna-define-method lunit-test-result-run ((result lunit-test-result) case)
+  (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-notify result 'lunit-test-listener-end case))
 
 (luna-define-method lunit-test-result-error ((result lunit-test-result)
 					     case error)
-  (let ((listeners (lunit-test-result-listeners-internal result))
-	(errors (lunit-test-result-errors-internal result)))
-    (if errors
-	(nconc errors (list (cons case error)))
-      (lunit-test-result-set-errors-internal result (list (cons case error))))
-    (dolist (listener listeners)
-      (lunit-test-listener-error listener 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 ((listeners (lunit-test-result-listeners-internal result))
-	(failures (lunit-test-result-failures-internal result)))
-    (if failures
-	(nconc failures (list (cons case failure)))
-      (lunit-test-result-set-failures-internal result (list (cons case failure))))
-    (dolist (listener listeners)
-      (lunit-test-listener-failure listener 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 (lunit-test-result-listeners-internal result)))
-    (if listeners
-	(nconc listeners (list listener))
-      (lunit-test-result-set-listeners-internal result (list listener)))))
+  (let ((listeners
+	 (lunit-test-result-listeners-internal result)))
+    (setq listeners (nconc listeners (list listener)))
+    (lunit-test-result-set-listeners-internal result listeners)))
 
 ;;; @ test case
 ;;;
@@ -226,9 +217,7 @@ TESTS holds a number of instances of `lunit-test'."
 
 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
   (let ((tests (lunit-test-suite-tests-internal suite)))
-    (if tests
-	(nconc tests (list test))
-      (lunit-test-suite-set-tests-internal suite (list test)))))
+    (lunit-test-suite-set-tests-internal suite (nconc tests (list test)))))
 
 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
   (let ((tests (lunit-test-suite-tests-internal suite))
@@ -248,7 +237,7 @@ 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)))
-    `(unless ,condition
+    `(when ,(not condition)
        (signal 'lunit-failure (list ',condition-expr)))))
 
 (luna-define-class lunit-test-printer (lunit-test-listener))
@@ -261,7 +250,8 @@ TESTS holds a number of instances of `lunit-test'."
 						 case failure)
   (princ (format " failure: %S" failure)))
 
-(luna-define-method lunit-test-listener-start ((printer lunit-test-printer) case)
+(luna-define-method lunit-test-listener-start ((printer lunit-test-printer)
+					       case)
   (princ (format "Running `%S#%S'..."
 		 (luna-class-name case)
 		 (lunit-test-name-internal case))))
@@ -275,6 +265,7 @@ TESTS holds a number of instances of `lunit-test'."
     (mapatoms
      (lambda (symbol)
        (if (and (fboundp symbol)
+		(string-match "^test" (symbol-name symbol))
 		(null (get symbol 'luna-method-qualifier)))
 	   (push (lunit-make-test-case class symbol) tests)))
      (luna-class-obarray (luna-find-class class)))
@@ -285,16 +276,55 @@ TESTS holds a number of instances of `lunit-test'."
   (let* ((printer
 	  (luna-make-entity 'lunit-test-printer))
 	 (result
-	  (lunit-make-test-result printer))
-	 failures
-	 errors)
+	  (lunit-make-test-result printer)))
     (lunit-test-run test result)
-    (setq failures (lunit-test-result-failures-internal result)
-	  errors (lunit-test-result-errors-internal result))
-    (princ (format "%d runs, %d failures, %d errors\n"
-		   (lunit-test-number-of-tests test)
-		   (length failures)
-		   (length errors)))))
+    (let ((failures
+	   (lunit-test-result-failures-internal result))
+	  (errors
+	   (lunit-test-result-errors-internal result)))
+      (princ (format "%d runs, %d failures, %d errors\n"
+		     (lunit-test-number-of-tests test)
+		     (length failures)
+		     (length errors))))))
+
+(defvar imenu-create-index-function)
+(defun lunit-create-index-function ()
+  (require 'imenu)
+  (save-excursion
+    (unwind-protect
+	(progn
+	  (goto-char (point-min))
+	  (setq imenu-generic-expression
+		'((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)))
+	  (funcall imenu-create-index-function))
+      (setq imenu-create-index-function lisp-imenu-generic-expression))))
+
+(defun lunit-generate-template (file)
+  (interactive "fGenerate lunit template for: ")
+  (save-excursion
+    (set-buffer (find-file-noselect file))
+    (let ((index-alist 
+	   (lunit-create-index-function)))
+      (with-output-to-temp-buffer "*Lunit template*"
+	(let* ((feature
+		(file-name-sans-extension
+		 (file-name-nondirectory file)))
+	       (class
+		(concat "test-" feature)))
+	  (set-buffer standard-output)
+	  (insert "\
+\(require 'lunit)
+\(require '" feature ")
+
+\(luna-define-class " class " (lunit-test-case))
+
+")
+	  (dolist (index index-alist)
+	    (insert "\
+\(luna-define-method " class "-" (car index) " ((case " class "))
+  (lunit-assert nil))
+
+")))))))
 
 (provide 'lunit)