1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Provide a default reporter, so that results don't just go into the bit

bucket if you use the test suite functions without a driver script.
(default-reporter): New variable.
(report): Send results to default-reporter if there are no registered
reporters.
(full-reporter): New function.
(user-reporter): Re-implemented in terms of full-reporter.
This commit is contained in:
Jim Blandy 1999-05-31 21:27:20 +00:00
parent df14bb39e3
commit 087dab1cf6

View file

@ -36,6 +36,7 @@
register-reporter unregister-reporter reporter-registered?
make-count-reporter print-counts
make-log-reporter
full-reporter
user-reporter
format-test-name)
@ -137,6 +138,11 @@
;;;; This library provides some standard reporters for logging results
;;;; to a file, reporting interesting results to the user, and
;;;; collecting totals.
;;;;
;;;; You can use the REGISTER-REPORTER function and friends to add
;;;; whatever reporting functions you like. If you don't register any
;;;; reporters, the library uses FULL-REPORTER, which simply writes
;;;; all results to the standard output.
;;;; with-test-prefix: naming groups of tests
@ -171,6 +177,9 @@
;;; The global list of reporters.
(define reporters '())
;;; The default reporter, to be used only if no others exist.
(define default-reporter #f)
;;; Add the procedure REPORTER to the current set of reporter functions.
;;; Signal an error if that reporter procedure object is already registered.
(define (register-reporter reporter)
@ -192,8 +201,10 @@
;;; Send RESULT to all currently registered reporter functions.
(define (report result)
(for-each (lambda (reporter) (reporter result))
reporters))
(if (pair? reporters)
(for-each (lambda (reporter) (reporter result))
reporters)
(default-reporter result)))
;;;; Some useful reporter functions.
@ -274,15 +285,27 @@
(newline port)
(force-output port))))
;;; A reporter that reports all results to the user.
(define (full-reporter result)
(let ((label (case (car result)
((pass) "pass")
((fail) "FAIL")
((xpass) "XPASS")
((xfail) "xfail")
((error) "ERROR")
(else #f))))
(if label
(display-line label ": " (format-test-name (cdr result)))
(error "(test-suite lib) FULL-REPORTER: unrecognized result: "
result))))
;;; A reporter procedure which shows interesting results (failures,
;;; unexpected passes) to the user.
(define (user-reporter result)
(let ((label (case (car result)
((fail) "FAIL")
((xpass) "XPASS")
(else #f))))
(if label
(display-line label ": " (format-test-name (cdr result))))))
(case (car result)
((fail xpass) (full-reporter result))))
(set! default-reporter full-reporter)
;;;; Marking independent groups of tests.