Fixed bug, improved error reporting for typecheck-fail

This commit is contained in:
Georges Dupéron 2017-09-26 12:24:44 +02:00
parent 147536c9e7
commit 44d7866687
2 changed files with 20 additions and 16 deletions

View File

@ -15,7 +15,7 @@
reverse length list-ref member)
(define-type-constructor List
#:arity >= 0
#:arity = 1
#:arg-variances (λ (stx) (make-list (sub1 (stx-length stx)) covariant)))
(define-typed-syntax nil

View File

@ -76,21 +76,25 @@
(if (attribute msg-pat)
(eval-syntax (datum->stx #'h (stx->datum #'msg-pat)))
(eval-syntax (datum->stx #'h `(add-escs ,(stx->datum #'vmsg)))))
#:when (with-check-info*
(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))))
(λ ()
(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)]))
#`(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)]))
(define-syntax (typecheck-fail/toplvl stx)
(syntax-parse stx #:datum-literals (:)