diff --git a/tapl/tests/rackunit-typechecking.rkt b/tapl/tests/rackunit-typechecking.rkt index 06ecc53..f7eb860 100644 --- a/tapl/tests/rackunit-typechecking.rkt +++ b/tapl/tests/rackunit-typechecking.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require (for-syntax rackunit) rackunit "../typecheck.rkt") +(require (for-syntax rackunit syntax/srcloc) rackunit "../typecheck.rkt") (provide check-type typecheck-fail check-not-type check-props) (begin-for-syntax @@ -69,22 +69,25 @@ [(_ e (~optional (~seq #:with-msg msg-pat) #:defaults ([msg-pat #'""]))) #:with msg:str (eval-syntax (datum->syntax #'here (syntax->datum #'msg-pat))) - #:when (check-exn - (λ (ex) (or (exn:fail? ex) (exn:test:check? ex))) + #:when (with-check-info* + (list (make-check-location (build-source-location-list stx))) (λ () - (with-handlers - ; check err msg matches - ([exn:fail? - (λ (ex) - (unless (regexp-match? (syntax-e #'msg) (exn-message ex)) - (printf - (string-append - "ERROR-MSG ERROR: wrong err msg produced by expression ~v:\n" - "EXPECTED:\nmsg matching pattern ~v,\nGOT:\n~v\n") - (syntax->datum #'e) (syntax-e #'msg) (exn-message ex))) - (raise ex))]) - (expand/df #'e))) - (format - "Expected type check failure but expression ~a has valid type, OR wrong err msg received." - (syntax->datum #'e))) + (check-exn + (λ (ex) (or (exn:fail? ex) (exn:test:check? ex))) + (λ () + (with-handlers + ; check err msg matches + ([exn:fail? + (λ (ex) + (unless (regexp-match? (syntax-e #'msg) (exn-message ex)) + (printf + (string-append + "ERROR-MSG ERROR: wrong err msg produced by expression ~v:\n" + "EXPECTED:\nmsg matching pattern ~v,\nGOT:\n~v\n") + (syntax->datum #'e) (syntax-e #'msg) (exn-message ex))) + (raise ex))]) + (expand/df #'e))) + (format + "Expected type check failure but expression ~a has valid type, OR wrong err msg received." + (syntax->datum #'e))))) #'(void)]))