From e6a46577a285f35ed8bf8a5c443cc901a3a31687 Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Sun, 30 Jul 2017 19:30:57 -0400 Subject: [PATCH 1/2] check-info: add check-info-ref helpers Add `check-info-ref` and `check-info-contains-key?`, similar to `hash-ref`, but you can omit the "hashtable" argument --- by default its `(current-check-info)` --- rackunit-lib/rackunit/private/check-info.rkt | 20 +++++++++++++++++++ .../tests/rackunit/check-info-test.rkt | 16 +++++++++++++++ 2 files changed, 36 insertions(+) diff --git a/rackunit-lib/rackunit/private/check-info.rkt b/rackunit-lib/rackunit/private/check-info.rkt index 5f87395..e6e3ee2 100644 --- a/rackunit-lib/rackunit/private/check-info.rkt +++ b/rackunit-lib/rackunit/private/check-info.rkt @@ -20,12 +20,18 @@ [struct verbose-info ([value any/c])] [info-value->string (-> any/c string?)] [current-check-info (parameter/c (listof check-info?))] + [check-info-contains-key? (check-info-> symbol? boolean?)] + [check-info-ref (check-info-> symbol? (or/c check-info? #f))] [with-check-info* ((listof check-info?) (-> any) . -> . any)]) with-check-info) (module+ for-test (provide trim-current-directory)) +(define (check-info-> dom cod) + (case-> (-> dom cod) + (-> (listof check-info?) dom cod))) + ;; Structures -------------------------------------------------- (struct check-info (name value) @@ -94,3 +100,17 @@ (define-check-type message any/c) (define-check-type actual any/c #:wrapper pretty-info) (define-check-type expected any/c #:wrapper pretty-info) + +(define check-info-ref + (case-lambda + [(k) + (check-info-ref (current-check-info) k)] + [(info k) + (findf (λ (i) (eq? k (check-info-name i))) info)])) + +(define check-info-contains-key? + (case-lambda + [(k) + (check-info-contains-key? (current-check-info) k)] + [(info k) + (and (check-info-ref info k) #t)])) diff --git a/rackunit-test/tests/rackunit/check-info-test.rkt b/rackunit-test/tests/rackunit/check-info-test.rkt index 33625a9..347ea3f 100644 --- a/rackunit-test/tests/rackunit/check-info-test.rkt +++ b/rackunit-test/tests/rackunit/check-info-test.rkt @@ -95,6 +95,22 @@ (list 'name 'location 'expression 'params 'custom1 'custom2)) (check-equal? (get-foo-info-names) expected-info-names)) + (test-case "check-info-ref / check-info-contains-key" + (define info0 (list (make-check-name 'my-name))) + (define info1 (list (make-check-message 'my-message))) + + (parameterize ([current-check-info info0]) + (check-not-false (check-info-ref 'name)) + (check-false (check-info-ref 'message)) + + (check-not-false (check-info-ref info1 'message)) + (check-false (check-info-ref info1 'name)) + + (check-true (check-info-contains-key? 'name)) + (check-false (check-info-contains-key? 'message)) + (check-true (check-info-contains-key? info1 'message)) + (check-false (check-info-contains-key? info1 'name)))) + (test-case "All tests for trim-current-directory" (test-case "trim-current-directory leaves directories outside the current directory alone" (check-equal? (trim-current-directory "/foo/bar/") "/foo/bar/")) From b7b8c9f9d702b30234a144ed06f36349634d88c9 Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Sun, 30 Jul 2017 19:47:26 -0400 Subject: [PATCH 2/2] check-exn: only update check-info message when user did not supply one --- rackunit-lib/rackunit/private/check.rkt | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/rackunit-lib/rackunit/private/check.rkt b/rackunit-lib/rackunit/private/check.rkt index 896a854..d50eee9 100644 --- a/rackunit-lib/rackunit/private/check.rkt +++ b/rackunit-lib/rackunit/private/check.rkt @@ -162,14 +162,17 @@ [exn:fail? (lambda (exn) (with-check-info* - (list - (make-check-message "Wrong exception raised") + (list/if + (and (not (check-info-contains-key? 'message)) + (make-check-message "Wrong exception raised")) (make-check-info 'exn-message (exn-message exn)) (make-check-info 'exn exn)) (lambda () (fail-check))))]) (thunk)) (with-check-info* - (list (make-check-message "No exception raised")) + (list/if + (and (not (check-info-contains-key? 'message)) + (make-check-message "No exception raised"))) (lambda () (fail-check)))))) (define-check (check-not-exn thunk) @@ -179,8 +182,9 @@ [exn? (lambda (exn) (with-check-info* - (list - (make-check-message "Exception raised") + (list/if + (and (not (check-info-contains-key? 'message)) + (make-check-message "Exception raised")) (make-check-info 'exception-message (exn-message exn)) (make-check-info 'exception exn)) (lambda () (fail-check))))])