;;;; * 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 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)))