Fixed bug, improved error reporting for typecheck-fail
This commit is contained in:
parent
147536c9e7
commit
44d7866687
|
@ -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
|
||||
|
|
|
@ -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 (:)
|
||||
|
|
Loading…
Reference in New Issue
Block a user