suzanne.soy/macrotypes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

srcloc for typecheck-fail

Browse Source
This commit is contained in:
AlexKnauth 2016-04-14 15:31:01 -04:00
parent d2749db6d6
commit 61f4304085
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
tapl/tests/rackunit-typechecking.rkt
View File

@ -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)]))