1 ;;;-*- Mode: Lisp; Package: LIFT-INTERFACE -*-
3 (defpackage "LIFT-INTERFACE"
15 #:run-tests-internal
))
17 (in-package #:lift-interface
)
19 (defvar *lift-report-window
* nil
)
21 (defclass lift-report-window
(fred-window)
26 (defun show-last-test-results (result)
27 (unless (and *lift-report-window
*
28 (typep *lift-report-window
* 'fred-window
)
29 (window-shown-p *lift-report-window
*))
30 (setf *lift-report-window
* (make-instance 'lift-report-window
)))
31 (let* ((*print-length
* nil
)
34 (win *lift-report-window
*))
37 (format nil
"~&Test Report for ~A: ~D test~:P run~:[~[~:;, ~:*~A Failure~:P~]~[~:;, ~:*~A Error~:P~]~;, All Passed~]"
38 (test-class-name result
) (length (tests-run result
))
39 (not (or (failures result
) (errors result
)))
40 (length (failures result
))
41 (length (errors result
))))
45 (describe-object result win
)
50 (defmethod run-tests-internal :around
((case test-mixin
) &key
)
51 (show-last-test-results (call-next-method)))
53 (u:define-around-advice run-tests show-results
54 (show-last-test-results (u:call-next-advice
)))
56 (run-tests :suite
'lift
::test-lift
)