Update domain name to kpe.io

[xlunit.git] / suite.lisp

diff --git a/suite.lisp b/suite.lisp
index 4592100637ad30c018cce32e270f7b4449ddcc7f..254211748790100ea6151fac9e5f4b715de0f92c 100644 (file)
--- a/suite.lisp
+++ b/suite.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: suite.lisp,v 1.8 2003/08/06 11:37:23 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,28 +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)))
 
 
 (defmacro def-test-method (method-name ((instance-name class-name)
-                                       &key (run t))
-                          &body method-body)
+                                        &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))))