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

Attempt to fix extra level of let for typecheck-fail

Browse Source
This commit is contained in:
Georges Dupéron 2017-09-26 13:18:33 +02:00
parent 6fd94fab24
commit c115b497c0
1 changed files with 23 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
turnstile/examples/tests/rackunit-typechecking.rkt
View File

@ -76,25 +76,29 @@
(if (attribute msg-pat)
(eval-syntax (datum->stx #'h (stx->datum #'msg-pat)))
(eval-syntax (datum->stx #'h `(add-escs ,(stx->datum #'vmsg)))))
#`(let-syntax ([chk (λ (_stx)
(with-check-info*
;; Most of these are actually ignored by rackunit's define-check.
(list (make-check-expected (syntax-e #'msg))
(make-check-expression (syntax->datum #'stx))
(make-check-location (build-source-location-list #'stx))
(make-check-name 'typecheck-fail)
(make-check-params (list (syntax->datum #'e) (syntax-e #'msg))))
(λ ()
#,(syntax/loc stx
(check-exn
(λ (ex)
(and (or (exn:fail? ex) (exn:test:check? ex))
; check err msg matches
(regexp-match? (syntax-e #'msg) (exn-message ex))))
(λ ()
(expand/df #'e))))))
#'(void))])
chk)]))
#:with transformer-proc #`(λ (_stx)
(with-check-info*
;; Most of these are actually ignored by rackunit's define-check.
(list (make-check-expected (syntax-e #'msg))
(make-check-expression (syntax->datum #'stx))
(make-check-location (build-source-location-list #'stx))
(make-check-name 'typecheck-fail)
(make-check-params (list (syntax->datum #'e) (syntax-e #'msg))))
(λ ()
#,(syntax/loc stx
(check-exn
(λ (ex)
(and (or (exn:fail? ex) (exn:test:check? ex))
; check err msg matches
(regexp-match? (syntax-e #'msg) (exn-message ex))))
(λ ()
(expand/df #'e))))))
#'(void))
(if (eq? (syntax-local-context) 'expression)
#'(let-syntax ([chk transformer-proc])
chk)
#'(begin (define-syntax chk transformer-proc)
chk))]))
(define-syntax (typecheck-fail/toplvl stx)
(syntax-parse stx #:datum-literals (:)