Add the *verbose-failures* flag

diff --git a/src/check.lisp b/src/check.lisp
index eba0adf..6bd27f6 100644 (file)
--- a/src/check.lisp
+++ b/src/check.lisp
@@ -33,7 +33,8 @@
 
 (defclass test-result ()
   ((reason :accessor reason :initarg :reason :initform "no reason given")
-   (test-case :accessor test-case :initarg :test-case))
+   (test-case :accessor test-case :initarg :test-case)
+   (test-expr :accessor test-expr :initarg :test-expr))
   (:documentation "All checking macros will generate an object of
  type TEST-RESULT."))
 
@@ -110,21 +111,22 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string."
           (test)
           "Argument to IS must be a list, not ~S" test)
   `(if ,test
-       (add-result 'test-passed)
+       (add-result 'test-passed :test-expr ',test)
        (add-result 'test-failure
-                 :reason ,(if (null reason-args)
-                              (list-match-case test
-                                ((not (?predicate ?expected ?actual))
-                                 `(format nil "~S was ~S to ~S" ,?actual ',?predicate ,?expected))
-                                ((not (?satisfies ?value))
-                                 `(format nil "~S satisfied ~S" ,?value ',?satisfies))
-                                ((?predicate ?expected ?actual)
-                                 `(format nil "~S was not ~S to ~S" ,?actual ',?predicate ,?expected))
-                                ((?satisfies ?value)
-                                 `(format nil "~S did not satisfy ~S" ,?value ',?satisfies))
-                                (t 
-                                 `(is-true ,test ,@reason-args)))
-                            `(format nil ,@reason-args)))))
+                   :reason ,(if (null reason-args)
+                                (list-match-case test
+                                  ((not (?predicate ?expected ?actual))
+                                   `(format nil "~S was ~S to ~S" ,?actual ',?predicate ,?expected))
+                                  ((not (?satisfies ?value))
+                                   `(format nil "~S satisfied ~S" ,?value ',?satisfies))
+                                  ((?predicate ?expected ?actual)
+                                   `(format nil "~S was not ~S to ~S" ,?actual ',?predicate ,?expected))
+                                  ((?satisfies ?value)
+                                   `(format nil "~S did not satisfy ~S" ,?value ',?satisfies))
+                                  (t 
+                                   `(is-true ,test ,@reason-args)))
+                                `(format nil ,@reason-args))
+                  :test-expr ',test)))
 
 ;;;; *** Other checks
 
@@ -140,10 +142,11 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string."
   does not inspect CONDITION to determine how to report the
   failure."
   `(if ,condition
-       (add-result 'test-passed)
+       (add-result 'test-passed :test-expr ',condition)
        (add-result 'test-failure :reason ,(if reason-args
                                              `(format nil ,@reason-args)
-                                             `(format nil "~S did not return a true value" ',condition)))))
+                                             `(format nil "~S did not return a true value" ',condition))
+                   :test-expr ',condition)))
 
 (defmacro is-false (condition &rest reason-args)
   "Generates a pass if CONDITION returns false, generates a
@@ -153,8 +156,9 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string."
   `(if ,condition
        (add-result 'test-failure :reason ,(if reason-args
                                              `(format nil ,@reason-args)
-                                             `(format nil "~S returned a true value" ',condition)))
-       (add-result 'test-passed)))
+                                             `(format nil "~S returned a true value" ',condition))
+                   :test-expr ',condition)
+       (add-result 'test-passed :test-expr ',condition)))
 
 (defmacro signals (condition &body body)
   "Generates a pass if BODY signals a condition of type
@@ -165,11 +169,14 @@ not evaluated."
        (handler-bind ((,condition (lambda (c)
                                     (declare (ignore c))
                                     ;; ok, body threw condition
-                                    (add-result 'test-passed)
+                                    (add-result 'test-passed 
+                                                :test-expr ',condition)
                                     (return-from ,block-name t))))
         (block nil
           ,@body
-          (add-result 'test-failure :reason (format nil "Failed to signal a ~S" ',condition))
+          (add-result 'test-failure 
+                       :reason (format nil "Failed to signal a ~S" ',condition)
+                       :test-expr ',condition)
           (return-from ,block-name nil))))))
 
 (defmacro finishes (&body body)
@@ -182,19 +189,24 @@ fails."
           ,@body
           (setf ok t))
        (if ok
-          (add-result 'test-passed)
+          (add-result 'test-passed :test-expr ',body)
           (add-result 'test-failure
-                      :reason (format nil "Test didn't finish"))))))
+                      :reason (format nil "Test didn't finish")
+                       :test-expr ',body)))))
 
 (defmacro pass (&rest message-args)
   "Simply generate a PASS."
-  `(add-result 'test-passed ,@(when message-args
-                               `(:reason (format nil ,@message-args)))))
+  `(add-result 'test-passed 
+               :test-expr ',message-args
+               ,@(when message-args
+                       `(:reason (format nil ,@message-args)))))
 
 (defmacro fail (&rest message-args)
   "Simply generate a FAIL."
-  `(add-result 'test-failure ,@(when message-args
-                                `(:reason (format nil ,@message-args)))))
+  `(add-result 'test-failure
+               :test-expr ',message-args
+               ,@(when message-args
+                       `(:reason (format nil ,@message-args)))))
 
 ;; Copyright (c) 2002-2003, Edward Marco Baringer
 ;; All rights reserved. 

diff --git a/src/explain.lisp b/src/explain.lisp
index 4e23e0e..bb76305 100644 (file)
--- a/src/explain.lisp
+++ b/src/explain.lisp
@@ -4,6 +4,9 @@
 
 ;;;; * Analyzing the results
 
+(defparameter *verbose-failures* nil
+  "T if we should print the expression failing, NIL otherwise.")
+
 ;;;; Just as important as defining and runnig the tests is
 ;;;; understanding the results. FiveAM provides the function EXPLAIN
 ;;;; which prints a human readable summary (number passed, number
@@ -35,6 +38,8 @@
        (format stream "~A ~@{[~A]~}: ~%" 
                (name (test-case f))
                (description (test-case f)))
+        (when (and *verbose-failures* (test-expr f))
+          (format stream "    ~S~%" (test-expr f)))
        (format stream "    ~A.~%" (reason f)))
       (terpri stream))
     (when skipped

diff --git a/src/packages.lisp b/src/packages.lisp
index 2847810..6536e28 100644 (file)
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -54,7 +54,8 @@
            #:!
            #:!!
            #:!!!
-          #:*debug-on-error*))
+          #:*debug-on-error*
+           #:*verbose-failures*))
 
 ;;;; You can use #+5am to put your test-defining code inline with your
 ;;;; other code - and not require people to have fiveam to run your