rackunit: drop redundant 'params info, use error-display-handler

Closes PR 11618

original commit: f6b73f01e174337534ed11e7ff78d095f16d6088

collects/rackunit/private/check.rkt

@@ -33,31 +33,9 @@
          check-not-equal?
          fail)
 
-
-(define USE-ERROR-HANDLER? #f)
-
 ;; default-check-handler : exn -> any
 (define (default-check-handler e)
-  (let ([out (open-output-string)])
+  (display-test-failure/error e))
-    ;;(display "check failed\n" out)
-    (parameterize ((current-output-port out))
-      (display-delimiter)
-      (cond [(exn:test:check? e)
-             (display-failure)
-             (newline)
-             (display-check-info-stack
-              (exn:test:check-stack e))]
-            [(exn? e)
-             (display-error)
-             (newline)
-             (display-exn e)])
-      (display-delimiter))
-    (cond [USE-ERROR-HANDLER?
-           ((error-display-handler) (get-output-string out)
-            ;; So that DrRacket won't recognize exn:fail:syntax, etc
-            (make-exn (exn-message exn) (exn-continuation-marks exn)))]
-          [else
-           (display (get-output-string out) (current-error-port))])))
 
 ;; parameter current-check-handler : (-> exn any)
 (define current-check-handler

collects/rackunit/private/format.rkt

@@ -2,6 +2,7 @@
 
 (require racket/match
          srfi/13
+         "base.rkt"
          "check-info.rkt")
 
 (provide display-check-info-name-value
@@ -12,7 +13,10 @@
 
          display-delimiter
          display-failure
-         display-error)
+         display-error
+
+         display-test-failure/error
+         strip-redundant-params)
 
 ;; name-width : integer
 ;;
@@ -43,7 +47,7 @@
 (define (display-check-info-stack check-info-stack)
   (for-each
    display-check-info
-   check-info-stack)
+   (strip-redundant-params check-info-stack))
   (newline))
 
 ;; display-test-name : (U string #f) -> void
@@ -59,11 +63,47 @@
 ;; Outputs a printed representation of the exception to
 ;; the current-output-port
 (define (display-exn exn)
-  (let ([op (open-output-string)])
+  (parameterize ((current-error-port (current-output-port)))
-    (parameterize ([current-error-port op])
+    ((error-display-handler) (exn-message exn) exn)
-      ((error-display-handler)
-       (exn-message exn)
-       exn))
-    (display (get-output-string op))
     (newline)))
 
+;; ----
+
+;; strip-redundant-parms : (list-of check-info) -> (list-of check-info)
+;;
+;; Strip any check-params? is there is an
+;; actual/expected check-info in the same stack frame.  A
+;; stack frame is delimited by occurrence of a check-name?
+(define (strip-redundant-params stack)
+  (define (binary-check-this-frame? stack)
+    (let loop ([stack stack])
+      (cond
+        [(null? stack) #f]
+        [(check-name? (car stack)) #f]
+        [(check-actual? (car stack)) #t]
+        [else (loop (cdr stack))])))
+  (let loop ([stack stack])
+    (cond
+      [(null? stack) null]
+      [(check-params? (car stack))
+       (if (binary-check-this-frame? stack)
+           (loop (cdr stack))
+           (cons (car stack) (loop (cdr stack))))]
+      [else (cons (car stack) (loop (cdr stack)))])))
+
+;; ----
+
+(define (display-test-failure/error e [name #f])
+  (parameterize ((current-output-port (current-error-port)))
+    (display-delimiter)
+    (when name (display-test-name name))
+    (cond [(exn:test:check? e)
+           (display-failure) (newline)
+           (display-check-info-stack (exn:test:check-stack e))
+           (when #t
+             (parameterize ((error-print-context-length 0))
+               ((error-display-handler) (exn-message e) e)))]
+          [(exn? e)
+           (display-error) (newline)
+           (display-exn e)])
+    (display-delimiter)))

collects/rackunit/private/test-case.rkt

@@ -16,8 +16,6 @@
          after
          around)
 
-(define USE-ERROR-HANDLER? #f)
-
 (define current-test-name
   (make-parameter
    #f
@@ -35,24 +33,7 @@
 
 ;; default-test-case-handler : exn -> any
 (define (default-test-case-handler e)
-  (let ([out (open-output-string)])
+  (display-test-failure/error e (current-test-name)))
-    ;;(display "test case failed\n" out)
-    (parameterize ((current-output-port out))
-      (display-delimiter)
-      (display-test-name (current-test-name))
-      (cond [(exn:test:check? e)
-             (display-failure)(newline)
-             (display-check-info-stack (exn:test:check-stack e))]
-            [(exn? e)
-             (display-error)(newline)
-             (display-exn e)])
-      (display-delimiter))
-    (cond [USE-ERROR-HANDLER?
-           ((error-display-handler) (get-output-string out)
-            ;; So that DrRacket won't recognize exn:fail:syntax, etc
-            (make-exn (exn-message e) (exn-continuation-marks e)))]
-          [else
-           (display (get-output-string out) (current-error-port))])))
 
 (define current-test-case-around
   (make-parameter

collects/rackunit/text-ui.rkt

@@ -97,37 +97,15 @@
     (else
      (void))))
 
-
-;; strip-redundant-parms : (list-of check-info) -> (list-of check-info)
-;;
-;; Strip any check-params? is there is an
-;; actual/expected check-info in the same stack frame.  A
-;; stack frame is delimited by occurrence of a check-name?
-(define (strip-redundant-params stack)
-  (define (binary-check-this-frame? stack)
-    (let loop ([stack stack])
-      (cond
-        [(null? stack) #f]
-        [(check-name? (car stack)) #f]
-        [(check-actual? (car stack)) #t]
-        [else (loop (cdr stack))])))
-  (let loop ([stack stack])
-    (cond
-      [(null? stack) null]
-      [(check-params? (car stack))
-       (if (binary-check-this-frame? stack)
-           (loop (cdr stack))
-           (cons (car stack) (loop (cdr stack))))]
-      [else (cons (car stack) (loop (cdr stack)))])))
-
-
 ;; display-context : test-result [(U #t #f)] -> void
 (define (display-context result [verbose? #f])
   (cond
     [(test-failure? result)
      (let* ([exn (test-failure-result result)]
             [stack (exn:test:check-stack exn)])
-       (textui-display-check-info-stack stack verbose?))]
+       (textui-display-check-info-stack stack verbose?)
+       (when #t
+         ((error-display-handler) (exn-message exn) exn)))]
     [(test-error? result)
      (let ([exn (test-error-result result)])
        (textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn)))