Print failed tests in the order of execution

[fiveam.git] / src / explain.lisp

diff --git a/src/explain.lisp b/src/explain.lisp
index 4e23e0e..84d6871 100644 (file)
--- a/src/explain.lisp
+++ b/src/explain.lisp
@@ -4,61 +4,77 @@
 
 ;;;; * 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
 ;;;; failed, what failed and why, etc.) of a list of test results.
 
-(defmethod explain ((exp detailed-text-explainer) results &optional (stream *test-dribble*))
-  "Given a list of test results report write to stream detailed
-  human readable statistics regarding the results."
+(defmethod explain ((exp detailed-text-explainer) results
+                    &optional (stream *test-dribble*) (recursive-depth 0))
+  #| "Given a list of test results report write to stream detailed
+  human readable statistics regarding the results." |# 
   (multiple-value-bind (num-checks passed num-passed passed%
                                   skipped num-skipped skipped%
                                   failed num-failed failed%
                                   unknown num-unknown unknown%)
       (partition-results results)
     (declare (ignore passed))
-    (when (zerop num-checks)
-      (format stream "~%Didn't run anything...huh?")
-      (return-from explain nil))
-    (format stream "~%Did ~D check~P.~%"
-           num-checks num-checks)
-    (format stream "   Pass: ~D (~2D%)~%" num-passed passed%)
-    (format stream "   Skip: ~D (~2D%)~%" num-skipped skipped%)
-    (format stream "   Fail: ~D (~2D%)~%" num-failed failed%)
-    (when unknown
-      (format stream "   UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
-    (terpri stream)
-    (when failed
-      (format stream "Failure Details:~%")
-      (dolist (f failed)
-       (format stream "~A ~@{[~A]~}: ~%" 
-               (name (test-case f))
-               (description (test-case f)))
-       (format stream "    ~A.~%" (reason f)))
-      (terpri stream))
-    (when skipped
-      (format stream "Skip Details:~%")
-      (dolist (f skipped)
-       (format stream "~A ~@{[~A]~}: ~%" 
-               (name (test-case f))
-               (description (test-case f)))
-       (format stream "    ~A.~%" (reason f)))
-      (terpri *test-dribble*))))
+    (flet ((output (&rest format-args)
+             (format stream "~&~vT" recursive-depth)
+             (apply #'format stream format-args)))
+      
+      (when (zerop num-checks)
+        (output "Didn't run anything...huh?")
+        (return-from explain nil))
+      (output "Did ~D check~P.~%" num-checks num-checks)
+      (output "   Pass: ~D (~2D%)~%" num-passed passed%)
+      (output "   Skip: ~D (~2D%)~%" num-skipped skipped%)
+      (output "   Fail: ~D (~2D%)~%" num-failed failed%)
+      (when unknown
+        (output "   UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
+      (terpri stream)
+      (when failed
+        (output "Failure Details:~%")
+        (dolist (f (reverse failed))
+          (output "--------------------------------~%")
+          (output "~A ~@{[~A]~}: ~%" 
+                  (name (test-case f))
+                  (description (test-case f)))
+          (output "     ~A.~%" (reason f))
+          (when (for-all-test-failed-p f)
+            (output "Results collected with failure data:~%")
+            (explain exp (slot-value f 'result-list)
+                     stream (+ 4 recursive-depth)))
+          (when (and *verbose-failures* (test-expr f))
+            (output "    ~S~%" (test-expr f)))
+          (output "--------------------------------~%"))
+        (terpri stream))
+      (when skipped
+        (output "Skip Details:~%")
+        (dolist (f skipped)
+          (output "~A ~@{[~A]~}: ~%" 
+                  (name (test-case f))
+                  (description (test-case f)))
+          (output "    ~A.~%" (reason f)))
+        (terpri *test-dribble*)))))
 
-(defmethod explain ((exp simple-text-explainer) results &optional (stream *test-dribble*))
+(defmethod explain ((exp simple-text-explainer) results
+                    &optional (stream *test-dribble*) (recursive-depth 0))
   (multiple-value-bind (num-checks passed num-passed passed%
                                   skipped num-skipped skipped%
                                   failed num-failed failed%
                                   unknown num-unknown unknown%)
       (partition-results results)
     (declare (ignore passed passed% skipped skipped% failed failed% unknown unknown%))
-    (format stream "~&Ran ~D checks, ~D passed" num-checks num-passed)
+    (format stream "~&~vTRan ~D checks, ~D passed" recursive-depth num-checks num-passed)
     (when (plusp num-skipped)
       (format stream ", ~D skipped " num-skipped))
     (format stream " and ~D failed.~%" num-failed)
     (when (plusp num-unknown)
-      (format stream "~D UNKNOWN RESULTS.~%" num-unknown))))
+      (format stream "~vT~D UNKNOWN RESULTS.~%" recursive-depth num-unknown))))
 
 (defun partition-results (results-list)
   (let ((num-checks (length results-list)))