Merge pull request #21 from rfindler/master
make the top-level checks look more like how they look when using text-ui
This commit is contained in:
Jay McCarthy
GitHub
commit
0584d9ecf3
|
|
@ -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]))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -47,9 +47,9 @@ Outta here!
|
|||
--------------------
|
||||
FAILURE
|
||||
name: check
|
||||
location: (#<path:PLTHOME/collects/tests/rackunit/standalone-check-test.rkt> 48 0 1450 17)
|
||||
expression: (check = 1 2)
|
||||
params: (#<procedure:=> 1 2)\nmessage: 0.0
|
||||
location: standalone-check-test.rkt:48:0
|
||||
params: (#<procedure:=> 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: (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 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: (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 24 21 664 15)
|
||||
expression: (check-eq? 1 2)
|
||||
|
||||
Check failure
|
||||
--------------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user