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"
   (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"
 
 (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"
 
 ;;; 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
 
 
 ;;; Now we can create a test-suite.  A test-suite contains a group of
 ;;; test-case.
 
 (setf math-test-suite (make-test-suite
 ;;; 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
 
 (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)
 
 ;;;; 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
 (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))