r11859: Canonicalize whitespace
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
xptest-example.lisp
xptestsuite.lisp

index d93bae1d28afa25f348fd14e591855b611314cf4..e96d0bf2bba5c5f4bd68033557ff6735cf8db669 100644 (file)
   (let ((result (+ (numbera test) (numberb test))))
     (unless (= result 5)
       (failure "Result was not 5 when adding ~A and ~A"
-              (numbera test) (numberb test)))))
+               (numbera test) (numberb test)))))
 
 (defmethod subtraction-test ((test math-fixture))
   (let ((result (- (numberb test) (numbera test))))
     (unless (= result 1)
       (failure "Result was not 1 when subtracting ~A ~A"
-             (numberb test) (numbera test)))))
+              (numberb test) (numbera test)))))
 
 ;;; This method is meant to signal a failure
 (defmethod subtraction-test2 ((test math-fixture))
   (let ((result (- (numbera test) (numberb test))))
     (unless (= result 1)
       (failure "Result was not 1 when subtracting ~A ~A"
-             (numbera test) (numberb test)))))
+              (numbera test) (numberb test)))))
 
 
 ;;; Now we can create a test-suite.  A test-suite contains a group of
 ;;; test-case.
 
 (setf math-test-suite (make-test-suite
-                      "Math Test Suite"
-                      "Simple test suite for arithmetic operators."
-                      ("Addition Test" 'math-fixture
-                       :test-thunk 'addition-test
-                       :description "A simple test of the + operator")
-                      ("Subtraction Test" 'math-fixture
-                       :test-thunk 'subtraction-test
-                       :description "A simple test of the - operator")))
+                       "Math Test Suite"
+                       "Simple test suite for arithmetic operators."
+                       ("Addition Test" 'math-fixture
+                        :test-thunk 'addition-test
+                        :description "A simple test of the + operator")
+                       ("Subtraction Test" 'math-fixture
+                        :test-thunk 'subtraction-test
+                        :description "A simple test of the - operator")))
 
 (add-test (make-test-case "Substraction Test 2" 'math-fixture
-                         :test-thunk 'subtraction-test2
-                         :description "A broken substraction test, should fail.")
-         math-test-suite)
+                          :test-thunk 'subtraction-test2
+                          :description "A broken substraction test, should fail.")
+          math-test-suite)
 
 ;;;; Finally we can run our test suite and see how it performs.
 ;;;; (report-result (run-test math-test-suite) :verbose t)
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
-         #+(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
@@ -93,14 +93,14 @@ setup method did for this instance."
   `(if ,test
        (handler-case
         ,form
-       ,@cases)
+        ,@cases)
      ,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))
@@ -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))
-       (failures ())
-       (errs ()))
+        (failures ())
+        (errs ()))
     (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)
-         (setf errs (cons err errs)))))
+          (setf errs (cons err errs)))))
     (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
@@ -138,23 +138,23 @@ ensure that test-fixture is a super."
      ,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
-                                   :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)))
-          
+
 (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)
-                (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"))
-        (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
-                                    :description ,description)))
+                                     :description ,description)))
        ,@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
-                     "------------------------------------------------------~%"))
+                      "------------------------------------------------------~%"))
   (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
-       (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))