;; -*- lisp -*-

(in-package :it.bese.FiveAM)

;;;; * 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."
  (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)))
        (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*))))

(defmethod explain ((exp simple-text-explainer) results &optional (stream *test-dribble*))
  (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)
    (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))))

(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)
      (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))))))))

;; Copyright (c) 2002-2003, Edward Marco Baringer
;; 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
;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE