r11859: Canonicalize whitespace
[xptest.git] / xptestsuite.lisp
index b873902b1eeca432b3d52726268c9d7d2fd09753..49e2d614b13feeb82b18b2c7c4938e2053f6df60 100644 (file)
@@ -75,10 +75,10 @@ setup method did for this instance."
 (defun failure (format-str &rest args)
   "Signal a test failure and exit the test."
   (signal 'test-failure
 (defun failure (format-str &rest args)
   "Signal a test failure and exit the test."
   (signal 'test-failure
-         #+(or cmu allegro openmcl) :format-control
-         #-(or cmu allegro openmcl) :format-string
-         format-str
-         :format-arguments args))
+          #+(or cmu allegro openmcl) :format-control
+          #-(or cmu allegro openmcl) :format-string
+          format-str
+          :format-arguments args))
 
 (defmacro test-assert (test)
   `(unless ,test
 
 (defmacro test-assert (test)
   `(unless ,test
@@ -93,14 +93,14 @@ setup method did for this instance."
   `(if ,test
        (handler-case
         ,form
   `(if ,test
        (handler-case
         ,form
-       ,@cases)
+        ,@cases)
      ,form))
 
 (defmacro unwind-protect-if (test protected cleanup)
   `(if ,test
        (unwind-protect
      ,form))
 
 (defmacro unwind-protect-if (test protected cleanup)
   `(if ,test
        (unwind-protect
-          ,protected
-        ,cleanup)
+           ,protected
+         ,cleanup)
      (progn ,protected ,cleanup)))
 
 (defmethod run-test ((test test-fixture) &key (handle-errors t))
      (progn ,protected ,cleanup)))
 
 (defmethod run-test ((test test-fixture) &key (handle-errors t))
@@ -108,28 +108,28 @@ setup method did for this instance."
 Returns one or more test-result objects, one for each test-case
 performed."
   (let ((start-time (get-universal-time))
 Returns one or more test-result objects, one for each test-case
 performed."
   (let ((start-time (get-universal-time))
-       (failures ())
-       (errs ()))
+        (failures ())
+        (errs ()))
     (unwind-protect-if handle-errors
     (unwind-protect-if handle-errors
-       (handler-case-if handle-errors
-        (let ((res (progn (setup test)
-                          (apply (test-thunk test) (list test)))))
-          (if (typep res 'test-failure)
-              (setf failures (cons res failures))))
-        (test-failure (failure)
-                      (setf failures (cons failure failures)))
-        (t (err)
-           (setf errs (cons err errs))))
+        (handler-case-if handle-errors
+         (let ((res (progn (setup test)
+                           (apply (test-thunk test) (list test)))))
+           (if (typep res 'test-failure)
+               (setf failures (cons res failures))))
+         (test-failure (failure)
+                       (setf failures (cons failure failures)))
+         (t (err)
+            (setf errs (cons err errs))))
       (handler-case-if handle-errors
        (teardown test)
        (t (err)
       (handler-case-if handle-errors
        (teardown test)
        (t (err)
-         (setf errs (cons err errs)))))
+          (setf errs (cons err errs)))))
     (make-instance 'test-result
     (make-instance 'test-result
-                  :test test
-                  :start-time start-time
-                  :stop-time (get-universal-time)
-                  :failures failures
-                  :errors errs)))
+                   :test test
+                   :start-time start-time
+                   :stop-time (get-universal-time)
+                   :failures failures
+                   :errors errs)))
 
 (defmacro def-test-fixture (name supers slotdefs &rest class-options)
   "Define a new test-fixture class.  Works just like defclass, but
 
 (defmacro def-test-fixture (name supers slotdefs &rest class-options)
   "Define a new test-fixture class.  Works just like defclass, but
@@ -138,23 +138,23 @@ ensure that test-fixture is a super."
      ,slotdefs ,@class-options))
 
 (defmacro make-test-case (name fixture &key
      ,slotdefs ,@class-options))
 
 (defmacro make-test-case (name fixture &key
-                              (test-thunk 'perform-test)
-                              (test-suite nil)
-                              (description "No description."))
+                               (test-thunk 'perform-test)
+                               (test-suite nil)
+                               (description "No description."))
   "Create a test-case which is an instance of FIXTURE.  TEST-THUNK 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."
   (let ((newtest (gensym "new-test")))
     `(let ((,newtest (make-instance ,fixture
   "Create a test-case which is an instance of FIXTURE.  TEST-THUNK 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."
   (let ((newtest (gensym "new-test")))
     `(let ((,newtest (make-instance ,fixture
-                                   :test-name ,name
-                                   :test-thunk ,(if (eq test-thunk 'perform-test)
-                                                    ''perform-test
-                                                  test-thunk)
-                                   :description ,description)))
+                                    :test-name ,name
+                                    :test-thunk ,(if (eq test-thunk 'perform-test)
+                                                     ''perform-test
+                                                   test-thunk)
+                                    :description ,description)))
        (if ,test-suite (add-test ,newtest ,test-suite))
        ,newtest)))
        (if ,test-suite (add-test ,newtest ,test-suite))
        ,newtest)))
-          
+
 (defclass test-suite ()
   ((name
     :initarg :name
 (defclass test-suite ()
   ((name
     :initarg :name
@@ -171,23 +171,23 @@ instance.  DESCRIPTION is obviously what it says it is."
 (defmethod tests ((suite test-suite))
   (let ((tlist nil))
     (maphash #'(lambda (k v)
 (defmethod tests ((suite test-suite))
   (let ((tlist nil))
     (maphash #'(lambda (k v)
-                (declare (ignore k))
-                (setf tlist (cons v tlist)))
-            (tests-hash suite))
+                 (declare (ignore k))
+                 (setf tlist (cons v tlist)))
+             (tests-hash suite))
     (reverse tlist)))
 
 (defmacro make-test-suite (name description &rest testspecs)
   "Returns a new test-suite.  TESTSPECS are just like lists of
 arguments to MAKE-TEST-CASE."
   (let* ((newsuite (gensym "test-suite"))
     (reverse tlist)))
 
 (defmacro make-test-suite (name description &rest testspecs)
   "Returns a new test-suite.  TESTSPECS are just like lists of
 arguments to MAKE-TEST-CASE."
   (let* ((newsuite (gensym "test-suite"))
-        (testforms (mapcar #'(lambda (spec)
-                               (list
-                                'add-test
-                                (cons 'make-test-case spec)
-                                newsuite))
-                           testspecs)))
+         (testforms (mapcar #'(lambda (spec)
+                                (list
+                                 'add-test
+                                 (cons 'make-test-case spec)
+                                 newsuite))
+                            testspecs)))
     `(let ((,newsuite (make-instance 'test-suite :name ,name
     `(let ((,newsuite (make-instance 'test-suite :name ,name
-                                    :description ,description)))
+                                     :description ,description)))
        ,@testforms
        ,newsuite)))
 
        ,@testforms
        ,newsuite)))
 
@@ -250,27 +250,27 @@ standard-output.  If VERBOSE is non-nil then will produce a lengthy
 and informative report, otherwise just prints wether the test passed
 or failed or errored out."
   (if verbose (format stream
 and informative report, otherwise just prints wether the test passed
 or failed or errored out."
   (if verbose (format stream
-                     "------------------------------------------------------~%"))
+                      "------------------------------------------------------~%"))
   (format stream "Test ~A ~A ~%"
   (format stream "Test ~A ~A ~%"
-         (test-name (result-test result))
-         (cond
-          ((test-failures result) "Failed")
-          ((test-errors result) "Errored")
-          (t "Passed")))
+          (test-name (result-test result))
+          (cond
+           ((test-failures result) "Failed")
+           ((test-errors result) "Errored")
+           (t "Passed")))
   (if verbose
       (progn
   (if verbose
       (progn
-       (format stream "Description: ~A~%" (description (result-test result)))
-       (if (test-failures result)
-           (progn
-             (format stream "Failures:~%")
-             (mapcar #'(lambda (fail) (format stream "    ~A" fail))
-                     (test-failures result))))
-       (if (test-errors result)
-           (progn
-             (format stream "Errors:~%")
-             (mapcar #'(lambda (fail) (format stream "    ~A" fail))
-                     (test-errors result))))))
-  ;(format stream "~%~%") ; debian bug #190398 
+        (format stream "Description: ~A~%" (description (result-test result)))
+        (if (test-failures result)
+            (progn
+              (format stream "Failures:~%")
+              (mapcar #'(lambda (fail) (format stream "    ~A" fail))
+                      (test-failures result))))
+        (if (test-errors result)
+            (progn
+              (format stream "Errors:~%")
+              (mapcar #'(lambda (fail) (format stream "    ~A" fail))
+                      (test-errors result))))))
+  ;(format stream "~%~%") ; debian bug #190398
   )
 
 (defmethod report-result ((results list) &key (stream t) (verbose nil))
   )
 
 (defmethod report-result ((results list) &key (stream t) (verbose nil))