X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=tcase.lisp;h=3d68142afba33e56f6b0f2cee2fc6040f6dbc77d;hp=da0d8ded73b5868c510094dac93ab7dee05e7a38;hb=6e195606e06173086a91616042adef3072633d92;hpb=381a23bb7ab8dd206bcd430ce9c7ee9c53e52f13

diff --git a/tcase.lisp b/tcase.lisp
index da0d8de..3d68142 100644
--- a/tcase.lisp
+++ b/tcase.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: tcase.lisp,v 1.1 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: tcase.lisp,v 1.2 2003/08/04 19:31:34 kevin Exp $
 ;;;; Purpose: Test fixtures for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -21,7 +21,7 @@
     :documentation
     "A function designator which will be applied to this instance
 to perform that test-case.")
-   (name :initarg :name :reader name
+   (name :initarg :name :reader name :initform ""
 	 :documentation "The name of this test-case, used in reports.")
    (description :initarg :description :reader description
 		:documentation
@@ -56,9 +56,11 @@ that the setup method did for this instance."))
 (defmethod tear-down ((test test-case))
   )
 
-(defmethod run ((ob test-case))
-  (run-on-test-results ob (make-instance 'test-results)))
-   
+(defmethod run ((ob test) &key (handle-errors t))
+  "Generalized to work on test-case and test-suites"
+  (let ((res (make-test-results)))
+    (run-on-test-results ob res :handle-errors t)
+    res))
 
 (defmethod run-on-test-results ((test test-case) result
 				&key (handle-errors t))
@@ -73,7 +75,7 @@ that the setup method did for this instance."))
     (tear-down test)))
 
 (defmethod run-test ((test test-case))
-  (funcall (method-body test)))
+    (funcall (method-body test)))
 
 (defmethod run-protected ((test test-case) res &key (handle-errors t))
   (handler-case
@@ -85,63 +87,5 @@ that the setup method did for this instance."))
   res)
 
 
-(defmacro handler-case-if (test form &body cases)
-  `(if ,test
-       (handler-case
-        ,form
-	,@cases)
-     ,form))
-
-(defmacro unwind-protect-if (test protected cleanup)
-  `(if ,test
-       (unwind-protect
-	   ,protected
-	 ,cleanup)
-     (progn ,protected ,cleanup)))
-
-#|
-(defmethod run-test ((test test-case)
-		     &key (result (make-instance 'test-results))
-		     (handle-errors t))
-  "Perform the test represented by the given test-case or test-suite.
-Returns a test-results object."
-  (incf (run-count result))
-  (with-slots (failures errors) result
-    (unwind-protect-if handle-errors
-	(handler-case-if handle-errors
-	 (let ((res (progn (setup test)
-			   (funcall (method-body test) test))))
-	   (when (typep res 'test-failure-condition)
-	     (push (make-test-failure test res) failures)))
-	 (test-failure-condition (failure)
-	   (push (make-test-failure test failure) failures))
-	 (error (err)
-	   (push (make-test-failure test err) errors)))
-	
-	(if handle-errors
-	    (handler-case
-		(teardown test)
-	      (error (err)
-		(push (make-test-failure test err) errors)))
-	    (teardown test))))
-  result)
-|#
-
-(defun make-test (fixture name &key method-body test-suite description)
-  "Create a test-case which is an instance of FIXTURE.  METHOD-BODY is
-the method that will be invoked when perfoming this test, and can be a
-symbol or a lambda taking a single argument, the test-case
-instance.  DESCRIPTION is obviously what it says it is."
-  (let ((newtest (make-instance fixture
-		   :name (etypecase name
-				(symbol
-				 (string-downcase (symbol-name name)))
-				(string
-				 name))
-		   :method-body 
-		   (if (and (symbolp name) (null method-body))
-		       name
-		     method-body)
-		   :description description)))
-    (when test-suite (add-test newtest test-suite))
-    newtest))
+
+