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

Make parse-type raise the right error for incorrect use of ->.

Browse Source
This commit is contained in:
Eric Dobson 2014-07-06 20:53:55 -07:00
parent eb8c2d33b1
commit 75310338dc
2 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt
View File

@ -479,6 +479,9 @@
(parse-type (attribute rest.type)))
#:kws (append (attribute mand.kws)
(attribute opt.kws)))]
[:->^
(parse-error #:delayed? #t "incorrect use of -> type constructor")
Err]
[id:identifier
(cond
;; if it's a type variable, we just produce the corresponding reference (which is in the HT)
@ -498,9 +501,6 @@
(set-box! alias-box (cons #'id (unbox alias-box))))
(add-disappeared-use (syntax-local-introduce #'id))
t)]
[(free-identifier=? #'id #'->)
(parse-error #:delayed? #t "incorrect use of -> type constructor")
Err]
[else
(parse-error #:delayed? #t (~a "type name `" (syntax-e #'id) "' is unbound"))
Err])]

28
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
View File

@ -5,6 +5,7 @@
racket/base
racket/dict
racket/set
syntax/parse
(base-env base-structs)
(env tvar-env type-alias-env)
(utils tc-utils)
@ -29,22 +30,28 @@
(do-standard-inits))
(define-syntax (pt-test stx)
(syntax-case stx (FAIL)
[(_ FAIL ty-stx)
(syntax/loc stx (pt-test FAIL ty-stx initial-tvar-env))]
[(_ FAIL ty-stx tvar-env)
(syntax-parse stx
[(_ (~datum FAIL) ty-stx:expr
(~optional tvar-env:expr #:defaults [(tvar-env #'initial-tvar-env)])
(~optional (~seq #:msg msg*:expr) #:defaults [(msg* #'#f)]))
(quasisyntax/loc stx
(test-case #,(format "~a" (syntax->datum #'ty-stx))
(unless
(define msg msg*)
(define actual-message
(phase1-phase0-eval
(with-handlers ([exn:fail:syntax? (lambda (exn) #'#t)])
(with-handlers ([exn:fail:syntax? (lambda (exn) #`#,(exn-message exn))])
(parameterize ([current-tvars tvar-env]
[delay-errors? #f])
(parse-type (quote-syntax ty-stx)))
#'#f))
(fail-check "No syntax error when parsing type."))))]
[(_ ts tv) (syntax/loc stx (pt-test ts tv initial-tvar-env))]
[(_ ty-stx ty-val tvar-env)
#'#f)))
(unless actual-message
(fail-check "No syntax error when parsing type."))
(when msg
(unless (regexp-match? msg actual-message)
(with-check-info (['expected msg] ['actual actual-message])
(fail-check "parse-type raised the wrong error message"))))))]
[(_ ty-stx:expr ty-val:expr
(~optional tvar-env:expr #:defaults [(tvar-env #'initial-tvar-env)]))
(quasisyntax/loc
stx
(test-case #,(format "~a" (syntax->datum #'ty-stx))
@ -163,6 +170,7 @@
(t:-> -Integer (-poly (x) (t:-> x x)))]
[(-> Integer (All (X) (-> X X)))
(t:-> -Integer (-poly (x) (t:-> x x)))]
[FAIL -> #:msg "incorrect use of -> type constructor"]
;; ->* types
[(->* (String Symbol) Void) (t:-> -String -Symbol -Void)]