X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcheck.lisp;h=e91b46df8351bee8cfd3679aab6da056fd5673fb;hb=25b02b6e536197f46c8951fed21a452340328bb9;hp=ecf6155004c2cb2873c7b7a322c7d959730b2fb0;hpb=98bf60f49ffa34c36fba1ec5eeefb1d96845dfbd;p=fiveam.git

diff --git a/src/check.lisp b/src/check.lisp
index ecf6155..e91b46d 100644
--- a/src/check.lisp
+++ b/src/check.lisp
@@ -147,16 +147,14 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string."
          (setf bindings (list (list v ?value))
                effective-test `(,?satisfies ,v)
                default-reason-args (list "~S did not satisfy ~S" v `',?satisfies)))
-        (t
+        (?_
          (setf bindings '()
                effective-test test
-               default-reason-args "No reason supplied.")))
+               default-reason-args (list "No reason supplied"))))
       `(let ,bindings
          (if ,effective-test
              (add-result 'test-passed :test-expr ',test)
-             (process-failure :reason ,(if (null reason-args)
-                                           `(format nil ,@default-reason-args)
-                                           `(format nil ,@reason-args))
+             (process-failure :reason (format nil ,@(or reason-args default-reason-args))
                               :test-expr ',test))))))
 
 ;;;; *** Other checks
@@ -193,27 +191,29 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string."
      :test-expr ',condition)
     (add-result 'test-passed :test-expr ',condition)))
 
-(defmacro signals ((condition &optional reason-control reason-args)
+(defmacro signals (condition-spec
                    &body body)
   "Generates a pass if BODY signals a condition of type
 CONDITION. BODY is evaluated in a block named NIL, CONDITION is
 not evaluated."
   (let ((block-name (gensym)))
-    `(block ,block-name
-       (handler-bind ((,condition (lambda (c)
-                                    (declare (ignore c))
-                                    ;; ok, body threw condition
-                                    (add-result 'test-passed 
-                                                :test-expr ',condition)
-                                    (return-from ,block-name t))))
-	 (block nil
-	   ,@body
-           (process-failure
-            :reason ,(if reason-control
-                         `(format nil ,reason-control ,@reason-args)
-                         `(format nil "Failed to signal a ~S" ',condition))
-            :test-expr ',condition)
-	   (return-from ,block-name nil))))))
+    (destructuring-bind (condition &optional reason-control reason-args)
+        (ensure-list condition-spec)
+      `(block ,block-name
+         (handler-bind ((,condition (lambda (c)
+                                      (declare (ignore c))
+                                      ;; ok, body threw condition
+                                      (add-result 'test-passed 
+                                                  :test-expr ',condition)
+                                      (return-from ,block-name t))))
+           (block nil
+             ,@body))
+         (process-failure
+          :reason ,(if reason-control
+                       `(format nil ,reason-control ,@reason-args)
+                       `(format nil "Failed to signal a ~S" ',condition))
+          :test-expr ',condition)
+         (return-from ,block-name nil)))))
 
 (defmacro finishes (&body body)
   "Generates a pass if BODY executes to normal completion. In