X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=fixture.lisp;h=84f28bf500cf06a9960ce225b4cb3c0c0c0981ee;hp=8408cc841c535cb5c9aa3a93f1f1719db522a145;hb=8133177de9c5d202520bd83b5e797ef7a39942ad;hpb=318cda1a328e9d99af2270c73cb13262e485a1ff

diff --git a/fixture.lisp b/fixture.lisp
index 8408cc8..84f28bf 100644
--- a/fixture.lisp
+++ b/fixture.lisp
@@ -2,31 +2,26 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:        fixture.lisp
-;;;; Purpose:     eXtreme Lisp Test Suite
-;;;; Authors:     Kevin Rosenberg and Craig Brozefsky
+;;;; ID:      $Id: fixture.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Test fixtures for XLUnit
 ;;;;
-;;;; $Id: fixture.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:xlunit)
 
 
 (defclass test-fixture ()
-  ((test-thunk
-    :initarg :test-thunk :reader test-thunk
-    :initform 'perform-test
+  ((test-fn
+    :initarg :test-fn :reader test-fn :initform nil
     :documentation
-    "A thunk or symbol which will be applied to this instance, a
-test-case, to perform that test-case. Defaults to 'perform-test")
+    "A function designator which will be applied to this instance
+to perform that test-case.")
    (test-name
-    :initarg :test-name
-    :reader test-name
+    :initarg :test-name :reader test-name
     :documentation
     "The name of this test-case, used in reports.")
    (test-description
-    :initarg :description
-    :reader description
+    :initarg :description :reader description
     :documentation
     "Short description of this test-case, uses in reports"))
   (:documentation
@@ -68,43 +63,31 @@ that the setup method did for this instance."))
 		     &key (result (make-instance 'test-result))
 		     (handle-errors t))
   "Perform the test represented by the given test-case or test-suite.
-Returns one or more test-result objects, one for each test-case
-performed."
+Returns a test-result object."
   (incf (test-count result))
   (with-slots (failures errors) result
     (unwind-protect-if handle-errors
 	(handler-case-if handle-errors
 	 (let ((res (progn (setup test)
-			   (funcall (test-thunk test) test))))
-	   (if (typep res 'test-failure-condition)
-	       (push (make-instance 'test-failure
-		       :failed-test test
-		       :thrown-condition res)
-		     failures)))
+			   (funcall (test-fn test) test))))
+	   (when (typep res 'test-failure-condition)
+	     (push (make-test-failure test res) failures)))
 	 (test-failure-condition (failure)
-				 (push (make-instance 'test-failure
-					 :failed-test test
-					 :thrown-condition failure)
-				       failures))
+	   (push (make-test-failure test failure) failures))
 	 (error (err)
-		(push (make-instance 'test-failure 
-			:failed-test test 
-			:thrown-condition err)
-		      errors)))
+	   (push (make-test-failure test err) errors)))
+	
 	(if handle-errors
 	    (handler-case
 		(teardown test)
 	      (error (err)
-		(push 
-		 (make-instance 'test-failure
-		   :failed-test test :thrown-condition err)
-		 errors)))
-	  (teardown test))))
+		(push (make-test-failure test err) errors)))
+	    (teardown test))))
   result)
 
 
-(defun make-test (fixture name &key test-thunk test-suite description)
-  "Create a test-case which is an instance of FIXTURE.  TEST-THUNK is
+(defun make-test (fixture name &key test-fn test-suite description)
+  "Create a test-case which is an instance of FIXTURE.  TEST-FN 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-fixture
 instance.  DESCRIPTION is obviously what it says it is."
@@ -114,11 +97,10 @@ instance.  DESCRIPTION is obviously what it says it is."
 				 (string-downcase (symbol-name name)))
 				(string
 				 name))
-		   :test-thunk 
-		   (if(and (symbolp name) (null test-thunk))
+		   :test-fn 
+		   (if(and (symbolp name) (null test-fn))
 		       name
-		     test-thunk)
+		     test-fn)
 		   :description description)))
-       (if test-suite (add-test newtest test-suite))
-       newtest))
-
+    (when test-suite (add-test newtest test-suite))
+    newtest))