diff --git a/pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/test-case.rkt b/pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/test-case.rkt index 136740e..f314e05 100644 --- a/pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/test-case.rkt +++ b/pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/test-case.rkt @@ -1,5 +1,6 @@ #lang racket/base (require (for-syntax racket/base) + racket/contract/base "format.rkt" "check.rkt") @@ -58,12 +59,16 @@ "Correct form is (test-begin expr ...)" stx)])) -(define-syntax test-case - (syntax-rules () - [(test-case name expr ...) - (parameterize - ([current-test-name name]) - (test-begin expr ...))])) +(define-syntax (test-case stx) + (syntax-case stx () + [(_ name expr ...) + (quasisyntax/loc stx + (parameterize + ([current-test-name + (contract string? name + '#,(syntax-source-module #'name #t) + '#,(syntax-source-module #'test-case #t))]) + (test-begin expr ...)))])) (define-syntax before (syntax-rules () diff --git a/pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/test-case-test.rkt b/pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/test-case-test.rkt index 695ce35..a2c5d84 100644 --- a/pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/test-case-test.rkt +++ b/pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/test-case-test.rkt @@ -12,6 +12,8 @@ (test-suite "test-case-tests" + (check-exn #rx"contract" (λ () (test-case 'foo))) + (test-case "test-begin terminates when sub-expression fails" (let ([fail? #f]) @@ -52,6 +54,8 @@ (test-case "dummy" (define yes #t) - (check-true yes))))))) + (check-true yes))))))))) - )) +(module+ test + (require rackunit/text-ui) + (run-tests test-case-tests))