;; -*- lisp -*-
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
;;;; * Analyzing the results
;;;; 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."
+(defgeneric explain (explainer results &optional stream recursive-depth))
+
+(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%)
+ 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)))
- (when (and *verbose-failures* (test-expr f))
- (format stream " ~S~%" (test-expr 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%)
+ 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)))
(destructuring-bind (passed skipped failed unknown)
- (partitionx results-list
- (lambda (res)
- (typep res 'test-passed))
- (lambda (res)
- (typep res 'test-skipped))
- (lambda (res)
- (typep res 'test-failure))
- t)
+ (partitionx results-list
+ (lambda (res)
+ (typep res 'test-passed))
+ (lambda (res)
+ (typep res 'test-skipped))
+ (lambda (res)
+ (typep res 'test-failure))
+ t)
(if (zerop num-checks)
- (values 0
- nil 0 0
- nil 0 0
- nil 0 0
- nil 0 0)
- (values
- num-checks
- passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
- skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
- failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
- unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
+ (values 0
+ nil 0 0
+ nil 0 0
+ nil 0 0
+ nil 0 0)
+ (values
+ num-checks
+ passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
+ skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
+ failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
+ unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
;; Copyright (c) 2002-2003, Edward Marco Baringer
-;; All rights reserved.
-;;
+;; All rights reserved.
+;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are
;; met:
-;;
+;;
;; - Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
-;;
+;;
;; - Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names
;; of its contributors may be used to endorse or promote products
;; derived from this software without specific prior written permission.
-;;
+;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
projects / fiveam.git / blobdiff