adjust plai test & co. to print only failing tests to stderr,

instead of printing all of them

also, adjust the plai test suites to cope with test results going
to two different places

collects/plai/scribblings/plai.scrbl

@@ -124,8 +124,7 @@ PLAI Scheme provides the following syntactic forms for testing.
 @defform/subs[(test result-expr expected-expr)()]{
 
 If @racket[_result-expr] and @racket[_expected-expr] evaluate to the same
-value, @racket[_result-value], the test prints the following expression
+value, @racket[_result-value], the test prints the following expression:
-to @racket[(current-error-port)]:
 
 @racketresultfont{(good result-expr result-value expected-value location)}.
 
@@ -141,6 +140,9 @@ If evaluating @racket[_expected-expr] signals an error, the test prints
 
 @racketresultfont{(pred-exception result-expr exception-message <no-expected-value> location)}
 
+If the printout begins with @racket[good], then it is printed to
+@racket[(current-output-port)]; otherwise it is printed to @racket[(current-error-port)].
+
 }
 
 @defform/subs[(test/pred result-expr pred?)()]{

collects/plai/test-harness.rkt

@@ -69,8 +69,8 @@
     (set! plai-all-test-results (cons result plai-all-test-results))
     (when print?
       (if (abridged-test-output)
-          (apply eprintf "(~s ~v ~v)\n" result)
+          (apply (if error? eprintf printf) "(~s ~v ~v)\n" result)
-          (apply eprintf "(~s ~s ~v ~v ~s)\n" result)))
+          (apply (if error? eprintf printf) "(~s ~s ~v ~v ~s)\n" result)))
     (when (and halt-on-errors? error?)
       (raise (make-exn:test (string->immutable-string (format "test failed: ~s" result))
                             (current-continuation-marks))))))

collects/tests/plai/datatype.rkt

@@ -1,5 +1,6 @@
 #lang plai
-(require (prefix-in eli: tests/eli-tester))
+(require (prefix-in eli: tests/eli-tester)
+         "util.rkt")
 
 (define-type A
   [mta]
@@ -28,15 +29,14 @@
 
 (define-type t1 (c1 (n number?)))
 
-
 (eli:test
  (i 4)
  
  (regexp-match "\\(exception \\(make-i #f\\) \"make-i.+\" '<no-expected-value> \"at line 36\"\\)"
-               (with-output-to-string (λ () (test/exn (make-i #f) "contract"))))
+               (with-both-output-to-string (λ () (test/exn (make-i #f) "contract"))))
  
  (regexp-match "\\(exception \\(i-f #f\\) \"i-f.+\" '<no-expected-value> \"at line 39\"\\)"
-               (with-output-to-string (λ () (test/exn (i-f #f) "contract"))))
+               (with-both-output-to-string (λ () (test/exn (i-f #f) "contract"))))
  
  
  (type-case A (mta)
@@ -46,13 +46,13 @@
  1
  
  (regexp-match "\\(exception \\(c1 \\(quote not-a-number\\)\\) \"c1.+\" '<no-expected-value> \"at line 49\"\\)"
-               (with-output-to-string (λ () (test (c1 'not-a-number) (list 5)))))
+               (with-both-output-to-string (λ () (test (c1 'not-a-number) (list 5)))))
  
  (regexp-match (regexp-quote "(exception (type-case t (list 1) (c () 1)) \"type-case: expected a value from type t, got: (1)\" '<no-expected-value> \"at line 53\")")
-               (with-output-to-string (λ ()
+               (with-both-output-to-string (λ ()
-                                        (test/exn
+                                             (test/exn
-                                         (type-case t (list 1) (c () 1))
+                                              (type-case t (list 1) (c () 1))
-                                         "expected"))))
+                                              "expected"))))
  
  (type-case "foo" "bar") =error> "this must be a type defined with define-type"
  

collects/tests/plai/gc/run-test.rkt

@@ -1,6 +1,7 @@
 #lang racket
 (require tests/eli-tester
-         racket/runtime-path)
+         racket/runtime-path
+         "../util.rkt")
 
 (define-runtime-path here ".")
 
@@ -23,7 +24,7 @@
 (define (drop-first-line e)
   (regexp-replace "^[^\n]+\n" e ""))
 (define-syntax-rule (capture-output e)
-  (drop-first-line (with-output-to-string (λ () e))))
+  (drop-first-line (with-both-output-to-string (λ () e))))
 
 (test
  (if (run-good?)

collects/tests/plai/gc2/run-test.rkt

@@ -1,6 +1,7 @@
 #lang racket
 (require tests/eli-tester
-         racket/runtime-path)
+         racket/runtime-path
+         "../util.rkt")
 
 (define-runtime-path here ".")
 
@@ -23,7 +24,7 @@
 (define (drop-first-line e)
   (regexp-replace "^[^\n]+\n" e ""))
 (define-syntax-rule (capture-output e)
-  (drop-first-line (with-output-to-string (λ () e))))
+  (drop-first-line (with-both-output-to-string (λ () e))))
 
 (test
  (if (run-good?)

collects/tests/plai/util.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(provide with-both-output-to-string)
+(define (with-both-output-to-string thunk)
+  (define sp (open-output-string))
+  (parameterize ([current-output-port sp]
+                 [current-error-port sp])
+    (thunk))
+  (get-output-string sp))