diff --git a/collects/compiler/commands/test.rkt b/collects/compiler/commands/test.rkt index ad51c0b6e4..a0b432ce2f 100644 --- a/collects/compiler/commands/test.rkt +++ b/collects/compiler/commands/test.rkt @@ -3,6 +3,7 @@ racket/match racket/path raco/command-name + rackunit/log planet2/lib) (define submodules '()) @@ -145,4 +146,5 @@ "Interpret arguments as packages" (set! packages? #t)] #:args file-or-directory - (for-each do-test-wrap file-or-directory)) + (begin (for-each do-test-wrap file-or-directory) + (test-log #:display? #t #:exit? #t))) diff --git a/collects/rackunit/log.rkt b/collects/rackunit/log.rkt new file mode 100644 index 0000000000..5ef8c9cdd0 --- /dev/null +++ b/collects/rackunit/log.rkt @@ -0,0 +1,36 @@ +#lang racket/base +(require racket/contract) + +(define TOTAL 0) +(define FAILED 0) + +(define-syntax-rule (inc! id) + (set! id (add1 id))) + +(define (test-log! result) + (inc! TOTAL) + (unless result + (inc! FAILED))) + +(define (test-log #:display? [display? #f] + #:exit? [exit? #f]) + (when display? + (unless (zero? TOTAL) + (cond + [(zero? FAILED) + (printf "~a test~a passed\n" + TOTAL + (if (= TOTAL 1) "" "s"))] + [else + (eprintf "~a/~a test failures\n" + FAILED TOTAL)]))) + (when exit? + (unless (zero? FAILED) + (exit 1)))) + +(provide + (contract-out + [test-log! + (-> any/c void?)] + [test-log + (->* () (#:display? boolean? #:exit? boolean?) void?)])) diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt index a0679bdc5d..900521857c 100644 --- a/collects/rackunit/private/check.rkt +++ b/collects/rackunit/private/check.rkt @@ -3,6 +3,7 @@ (require racket/match (for-syntax racket/base "location.rkt") + rackunit/log "base.rkt" "check-info.rkt" "format.rkt" @@ -71,6 +72,7 @@ (syntax-rules () ((_) (let ([marks (current-continuation-marks)]) + (test-log! #f) (raise (make-exn:test:check "Check failure" @@ -81,6 +83,7 @@ (syntax-rules () ((_) (let ([marks (current-continuation-marks)]) + (test-log! #f) (raise (make-exn:test:check:internal "Internal failure" @@ -93,6 +96,7 @@ ;; given parameter. Useful for propogating internal ;; errors to the outside world. (define (refail-check exn) + (test-log! #f) (raise (make-exn:test:check "Check failure" (exn-continuation-marks exn) @@ -121,7 +125,8 @@ (if message (list (make-check-message message)) null)) - (lambda () (begin expr ...))))) + (lambda () (begin0 (begin expr ...) (test-log! #t)))))) + ;; All checks should return (void). (void)))] [check-secret-name (datum->syntax stx (gensym (syntax->datum (syntax name))))]) diff --git a/collects/rackunit/scribblings/utils.scrbl b/collects/rackunit/scribblings/utils.scrbl index 6934ba3129..e9309ab2d7 100644 --- a/collects/rackunit/scribblings/utils.scrbl +++ b/collects/rackunit/scribblings/utils.scrbl @@ -1,7 +1,9 @@ #lang scribble/doc @(require scribble/manual - (for-label racket)) + (for-label racket + rackunit/log + rackunit/docs-complete)) @title{Testing Utilities} @@ -29,3 +31,28 @@ symbols or regexps are ignored. If it is a function, the function is treated as a predicate and passed each export of the module. If @racket[skip] is @racket[#f], no exports are skipped. } + +@section{Logging Test Results} +@defmodule[rackunit/log] + +Rackunit provides a general purpose library for tracking test results +and displaying a summary message. + +@defproc[(test-log! [result any/c]) + void?]{ + +Adds a test result to the running log. If @racket[result] is false, +then the test is considered a failure. + +} + +@defproc[(test-log [#:display? display? boolean? #t] + [#:exit? exit? boolean? #t]) + void?]{ + +Processes the running test log. If @racket[display?] is true, then a +message is displayed. If there were failures, the message is printed +on @racket[(current-error-port)]. If @racket[exit?] is true, then if +there were failures, calls @racket[(exit 1)]. + +} diff --git a/collects/tests/eli-tester.rkt b/collects/tests/eli-tester.rkt index eb50ec0630..c58e86b160 100644 --- a/collects/tests/eli-tester.rkt +++ b/collects/tests/eli-tester.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require scheme/match scheme/list scheme/string +(require scheme/match scheme/list scheme/string rackunit/log (for-syntax scheme/base scheme/match)) (define-syntax (safe stx) @@ -162,6 +162,8 @@ (lambda () (test-context #f) (let ([num (mcar c)] [exns (mcdr c)]) + (for ([i (in-range num)]) (test-log! #t)) + (for ([i (in-list exns)]) (test-log! #f)) (if (null? exns) (case pass [(loud) (printf "~a test~a passed\n" num (if (= num 1) "" "s"))] diff --git a/collects/tests/rackunit/log.rkt b/collects/tests/rackunit/log.rkt new file mode 100644 index 0000000000..53841e9d2f --- /dev/null +++ b/collects/tests/rackunit/log.rkt @@ -0,0 +1,43 @@ +#lang racket/base +(require rackunit + rackunit/log) + +(define-syntax-rule (&& label stdout-e stdout-p) + (let () + (define stdout-ev stdout-e) + (define stdout-av stdout-p) + (unless (equal? stdout-ev stdout-av) + (error 'log "Bad ~a: ~v vs ~v" label stdout-ev stdout-av)))) + +(define-syntax-rule (& test-e stdout-e stderr-e exit-e) + (let () + (define stdout-p (open-output-string)) + (define stderr-p (open-output-string)) + (define exit-av 0) + (parameterize ([current-output-port stdout-p] + [current-error-port stderr-p] + [exit-handler (λ (ec) (set! exit-av ec))]) + test-e) + (&& 'stdout stdout-e (get-output-string stdout-p)) + (&& 'stderr stderr-e (get-output-string stderr-p)) + (&& 'exit-code exit-e exit-av))) + +(& (test-log) "" "" 0) +(& (test-log #:display? #t) "" "" 0) +(& (test-log #:exit? #t) "" "" 0) +(& (test-log #:display? #t #:exit? #t) "" "" 0) + +(check-true #t) + +(& (test-log) "" "" 0) +(& (test-log #:display? #t) "1 test passed\n" "" 0) +(& (test-log #:exit? #t) "" "" 0) +(& (test-log #:display? #t #:exit? #t) "1 test passed\n" "" 0) + +(parameterize ([current-error-port (current-output-port)]) + (check-true #f)) + +(& (test-log) "" "" 0) +(& (test-log #:display? #t) "" "1/2 test failures\n" 0) +(& (test-log #:exit? #t) "" "" 1) +(& (test-log #:display? #t #:exit? #t) "" "1/2 test failures\n" 1)