diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt index 6a6ad8b4..4bd5ad6e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt @@ -29,7 +29,7 @@ #:declare s-kp (id-from 'struct:keyword-procedure 'racket/private/kw) #:declare kpe (id-from 'keyword-procedure-extract 'racket/private/kw) (match (tc-expr #'fn) - [(tc-result1: + [(tc-result1: (Poly: vars (Function: (list (and ar (arr: dom rng (and rest #f) (and drest #f) kw-formals)))))) (=> fail) @@ -47,7 +47,7 @@ #'kw-arg-list #'pos-args expected)] [(tc-result1: (Poly: _ (Function: _))) (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)]))) (define (tc-keywords/internal arity kws kw-args error?) @@ -110,7 +110,7 @@ arities doms rests drests rngs (stx-map tc-expr pos-args) #f #f #:expected expected - #:return (or expected (ret (Un))) + #:return (ret (Un)) #:msg-thunk (lambda (dom) (string-append "No function domains matched in function application:\n" diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 22a9a212..88f841d3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -2688,6 +2688,17 @@ #:ret (ret -String) #: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 "tc-literal tests"