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

Fix misuse of expected in tc-keywords.

Browse Source
This commit is contained in:
Eric Dobson 2014-03-27 09:07:02 -07:00
parent eaafd418d9
commit 2bb3fa9138
2 changed files with 14 additions and 3 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/typecheck/tc-app/tc-app-keywords.rkt
View File

@ -29,7 +29,7 @@
#:declare s-kp (id-from 'struct:keyword-procedure 'racket/private/kw) #:declare s-kp (id-from 'struct:keyword-procedure 'racket/private/kw)
#:declare kpe (id-from 'keyword-procedure-extract 'racket/private/kw) #:declare kpe (id-from 'keyword-procedure-extract 'racket/private/kw)
(match (tc-expr #'fn) (match (tc-expr #'fn)
[(tc-result1: [(tc-result1:
(Poly: vars (Poly: vars
(Function: (list (and ar (arr: dom rng (and rest #f) (and drest #f) kw-formals)))))) (Function: (list (and ar (arr: dom rng (and rest #f) (and drest #f) kw-formals))))))
(=> fail) (=> fail)
@ -47,7 +47,7 @@
#'kw-arg-list #'pos-args expected)] #'kw-arg-list #'pos-args expected)]
[(tc-result1: (Poly: _ (Function: _))) [(tc-result1: (Poly: _ (Function: _)))
(tc-error/expr "Inference for polymorphic keyword functions not supported")] (tc-error/expr "Inference for polymorphic keyword functions not supported")]
[(tc-result1: t) [(tc-result1: t)
(tc-error/expr "Cannot apply expression of type ~a, since it is not a function type" t)]))) (tc-error/expr "Cannot apply expression of type ~a, since it is not a function type" t)])))
(define (tc-keywords/internal arity kws kw-args error?) (define (tc-keywords/internal arity kws kw-args error?)
@ -110,7 +110,7 @@
arities doms rests drests rngs arities doms rests drests rngs
(stx-map tc-expr pos-args) (stx-map tc-expr pos-args)
#f #f #:expected expected #f #f #:expected expected
#:return (or expected (ret (Un))) #:return (ret (Un))
#:msg-thunk #:msg-thunk
(lambda (dom) (lambda (dom)
(string-append "No function domains matched in function application:\n" (string-append "No function domains matched in function application:\n"

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

@ -2688,6 +2688,17 @@
#:ret (ret -String) #:ret (ret -String)
#:expected (ret -String -no-filter -no-obj)] #:expected (ret -String -no-filter -no-obj)]
[tc-err
(let ()
(: z (case->
(-> Number #:b Symbol Number)
(-> Symbol #:b Symbol Symbol)))
(define z (lambda (a #:b b) a))
(z "y" #:b "y"))
#:ret (ret -String)
#:expected (ret -String -no-filter -no-obj)]
) )
(test-suite (test-suite
"tc-literal tests" "tc-literal tests"