X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=suite.lisp;h=254211748790100ea6151fac9e5f4b715de0f92c;hp=391258e26afb373f15de2b9f014b62dc7882c456;hb=HEAD;hpb=3d99efdf0959b199cc4b2e020c7692f650094f73

diff --git a/suite.lisp b/suite.lisp
index 391258e..2542117 100644
--- a/suite.lisp
+++ b/suite.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: suite.lisp,v 1.7 2003/08/05 22:56:25 kevin Exp $
+;;;; ID:      $Id$
 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -13,11 +13,11 @@
   ((name :initform "" :initarg :name :reader test-suite-name)
    (tests :initarg :tests :accessor tests :initform nil)
    (description :initarg :description :reader description
-		:initform "No description.")))
+                :initform "No description.")))
 
 (defmacro get-suite (class-name)
   `(suite (make-instance ',class-name)))
- 
+
 
 (defmethod add-test ((ob test-suite) (new-test test))
   (remove-test new-test ob)
@@ -25,28 +25,28 @@
 
 
 (defmethod run-on-test-results ((ob test-suite) (result test-results)
-				&key (handle-errors t))
+                                &key (handle-errors t))
   (mapc #'(lambda (composite)  ;;test-case or suite
             (run-on-test-results composite result
-				:handle-errors handle-errors))
+                                :handle-errors handle-errors))
         (tests ob)))
 
 (defmethod named-test (name (suite test-suite))
   (some (lambda (test-or-suite)
-	  (when (and (typep test-or-suite 'test-case)
-		     (equal name (name test-or-suite)))
-	    test-or-suite))
-	(tests suite)))
+          (when (and (typep test-or-suite 'test-case)
+                     (equal name (name test-or-suite)))
+            test-or-suite))
+        (tests suite)))
 
 (defmethod remove-test ((test test) (suite test-suite))
   (setf (tests suite)
     (delete-if #'(lambda (existing-tests-or-suite)
-		   (cond ((typep existing-tests-or-suite 'test-suite)
-			  (eq existing-tests-or-suite test))
-			 ((typep existing-tests-or-suite 'test-case)
-			  (eql (name existing-tests-or-suite)
-			       (name test)))))
-	       (tests suite))))
+                   (cond ((typep existing-tests-or-suite 'test-suite)
+                          (eq existing-tests-or-suite test))
+                         ((typep existing-tests-or-suite 'test-case)
+                          (eql (name existing-tests-or-suite)
+                               (name test)))))
+               (tests suite))))
 
 ;; Dynamic test suite
 
@@ -55,43 +55,28 @@
 class of an instance and whose name begins with the string 'test-'.
 This is used to dynamically generate a list of tests for a fixture."
   (let ((res)
-	(package (symbol-package (class-name (class-of instance)))))
+        (package (symbol-package (class-name (class-of instance)))))
     (do-symbols (s package)
       (when (and (> (length (symbol-name s)) 5)
-		 (string-equal "test-" (subseq (symbol-name s) 0 5))
-		 (fboundp s)
-		 (typep (symbol-function s) 'generic-function)
-		 (ignore-errors
-		   (plusp (length (compute-applicable-methods 
-				   (ensure-generic-function s)
-				   (list instance))))))
-	(push s res)))
+                 (string-equal "test-" (subseq (symbol-name s) 0 5))
+                 (fboundp s)
+                 (typep (symbol-function s) 'generic-function)
+                 (ignore-errors
+                   (plusp (length (compute-applicable-methods
+                                   (ensure-generic-function s)
+                                   (list instance))))))
+        (push s res)))
     (nreverse res)))
 
 
-;----------------------------------------------------------------------
-; macro def-test-method
-;
-; Creates the representation of a test method (included within a
-; test-case object) and add it to the corresponding suite class.
-; => clos version of the pluggable selector pattern
-;
-; use:  (def-test-method test-assert-false (clos-unit-test)
-;          (assert-true (eql (+ 1 2) 4) "comment"))
-;
-; new: it calls the textui-test-run function during eval, so to
-;      allow the usual lisp-like incremental developing and test.
-;----------------------------------------------------------------------
-                                                                                 
-(defmacro def-test-method ((method-name instance-name class-name
-			    &key (run t))
-			   &body method-body)
+(defmacro def-test-method (method-name ((instance-name class-name)
+                                        &key (run t))
+                           &body method-body)
   `(let ((,instance-name
           (make-instance ',class-name
             :name ',method-name)))
      (setf (method-body ,instance-name)
            #'(lambda() ,@method-body))
      (add-test (suite ,instance-name) ,instance-name)
-     (when ,run 
+     (when ,run
        (textui-test-run ,instance-name))))
-