diff --git a/rackunit-lib/rackunit/private/format.rkt b/rackunit-lib/rackunit/private/format.rkt index 36169ca..e9e52f3 100644 --- a/rackunit-lib/rackunit/private/format.rkt +++ b/rackunit-lib/rackunit/private/format.rkt @@ -1,7 +1,9 @@ #lang racket/base (require racket/match "base.rkt" - "check-info.rkt") + "check-info.rkt" + "text-ui-util.rkt" + "location.rkt") (provide display-check-info-name-value display-check-info @@ -15,7 +17,10 @@ display-test-failure/error strip-redundant-params - check-info-stack-max-name-width) + check-info-stack-max-name-width + + display-verbose-check-info + sort-stack) ;; name-width : integer ;; @@ -56,6 +61,33 @@ [(struct check-info (name value)) (display-check-info-name-value max-name-width name value)])) +;; display-verbose-check-info : test-result -> void +(define (display-verbose-check-info result) + (cond + ((test-failure? result) + (let* ((exn (test-failure-result result)) + (stack (exn:test:check-stack exn))) + (display-verbose-check-info-stack check-info-stack))) + ((test-error? result) + (display-exn (test-error-result result))) + (else + (void)))) + +(define (display-verbose-check-info-stack check-info-stack) + (define max-name-width (check-info-stack-max-name-width check-info-stack)) + (for ([info (in-list (sort-stack check-info-stack))]) + (cond + ((check-location? info) + (display-check-info-name-value max-name-width + 'location + (trim-current-directory + (location->string + (check-info-value info))) + (λ (x) (printf "~a\n" x)))) + (else + (display-check-info-name-value max-name-width + (check-info-name info) + (check-info-value info)))))) (define (check-info-stack-max-name-width check-info-stack) (apply max 0 @@ -63,11 +95,9 @@ ;; display-check-info-stack : (listof check-info) -> void (define (display-check-info-stack check-info-stack) - (define max-name-width (check-info-stack-max-name-width check-info-stack)) - (define (display-check-info-with-width check-info) - (display-check-info max-name-width check-info)) - (for-each display-check-info-with-width - (strip-redundant-params check-info-stack)) + (display-verbose-check-info-stack + (filter (λ (x) (not (check-expression? x))) + (strip-redundant-params check-info-stack))) (newline)) ;; display-test-name : (U string #f) -> void @@ -131,3 +161,21 @@ (display-error) (newline) (display-exn e)]) (display-delimiter))) + +(define (sort-stack l) + (sort l < + #:key + (λ (info) + (cond + [(check-name? info) + 0] + [(check-location? info) + 1] + [(check-params? info) + 2] + [(check-actual? info) + 3] + [(check-expected? info) + 4] + [else + 5])))) diff --git a/rackunit-lib/rackunit/text-ui.rkt b/rackunit-lib/rackunit/text-ui.rkt index b897290..31a191f 100644 --- a/rackunit-lib/rackunit/text-ui.rkt +++ b/rackunit-lib/rackunit/text-ui.rkt @@ -111,24 +111,6 @@ (display-exn exn))] [else (void)])) -(define (sort-stack l) - (sort l < - #:key - (λ (info) - (cond - [(check-name? info) - 0] - [(check-location? info) - 1] - [(check-params? info) - 2] - [(check-actual? info) - 3] - [(check-expected? info) - 4] - [else - 5])))) - (define (textui-display-check-info-stack stack [verbose? #f]) (define max-name-width (check-info-stack-max-name-width stack)) (for-each @@ -172,31 +154,6 @@ stack (strip-redundant-params stack))))) -;; display-verbose-check-info : test-result -> void -(define (display-verbose-check-info result) - (cond - ((test-failure? result) - (let* ((exn (test-failure-result result)) - (stack (exn:test:check-stack exn))) - (for-each - (lambda (info) - (cond - ((check-location? info) - (display "location: ") - (display (trim-current-directory - (location->string - (check-info-value info))))) - (else - (display (check-info-name info)) - (display ": ") - (write (check-info-value info)))) - (newline)) - (sort-stack stack)))) - ((test-error? result) - (display-exn (test-error-result result))) - (else - (void)))) - (define (std-test/text-ui display-context test) (fold-test-results (lambda (result seed) diff --git a/rackunit-test/tests/rackunit/standalone.rkt b/rackunit-test/tests/rackunit/standalone.rkt index b3f6d63..f781611 100644 --- a/rackunit-test/tests/rackunit/standalone.rkt +++ b/rackunit-test/tests/rackunit/standalone.rkt @@ -47,9 +47,9 @@ Outta here! -------------------- FAILURE name: check -location: (# 48 0 1450 17) -expression: (check = 1 2) -params: (# 1 2)\nmessage: 0.0 +location: standalone-check-test.rkt:48:0 +params: (# 1 2) +message: 0.0 Check failure -------------------- @@ -71,22 +71,20 @@ Second Outta here! -------------------- -------------------- FAILURE +name: check-eq? +location: standalone-test-case-test.rkt:23:12 actual: 1 expected: 2 -name: check-eq? -location: (# 23 12 626 15) -expression: (check-eq? 1 2) Check failure -------------------- -------------------- failure FAILURE +name: check-eq? +location: standalone-test-case-test.rkt:24:21 actual: 1 expected: 2 -name: check-eq? -location: (# 24 21 664 15) -expression: (check-eq? 1 2) Check failure --------------------