www

commit 61f4304085a2862645f369d1eaeceeda277a7133
parent d2749db6d6a5311499dcc7ea6407e72d3bcd8955
Author: AlexKnauth <alexander@knauth.org>
Date:   Thu, 14 Apr 2016 15:31:01 -0400

srcloc for typecheck-fail

Diffstat:
M
tapl/tests/rackunit-typechecking.rkt
 | 
39
+++++++++++++++++++++------------------

1 file changed, 21 insertions(+), 18 deletions(-)
diff --git 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)]))