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

Fix typecheck-fail in TR

Browse Source 
Closes PR 14449
This commit is contained in:
Asumu Takikawa 2014-04-18 11:14:30 -04:00
parent 34abe306e3
commit 9e7b013a7d
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/internal-forms.rkt
View File

@ -113,9 +113,14 @@
[predicate-assertion [predicate-assertion
(assert-predicate-internal type predicate)] (assert-predicate-internal type predicate)]
[type-declaration [type-declaration
(:-internal id:identifier type)] (:-internal id:identifier type)])
[typecheck-failure
(typecheck-fail-internal stx message:str var:id)]) ;; Define separately outside of `define-internal-classes` since this form
;; is meant to appear in expression positions, so it doesn't make sense to use
;; the `define-values` protocol used for other internal forms.
(define-syntax-class typecheck-failure
#:literal-sets (kernel-literals internal-literals)
(pattern (quote-syntax (typecheck-fail-internal stx message:str var))))
;;; Internal form creation ;;; Internal form creation
(begin-for-syntax (begin-for-syntax

6
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2747,6 +2747,12 @@
(f 1 2 3)) (f 1 2 3))
#:ret (ret Univ -true-filter)] #:ret (ret Univ -true-filter)]
;; typecheck-fail should fail
[tc-err (typecheck-fail #'stx "typecheck-fail")
#:msg #rx"typecheck-fail"]
[tc-err (string-append (typecheck-fail #'stx "typecheck-fail") "bar")
#:ret (ret -String)
#:msg #rx"typecheck-fail"]
) )
(test-suite (test-suite
"tc-literal tests" "tc-literal tests"