Adding test logging facility to rackunit and eli-tester, with its own test and docs

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

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?)]))

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

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)].
+
+}

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"))]

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)