From d426867956df2a174f01b14cd720e1a8f1f67d7d Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Mon, 25 Mar 2013 21:30:18 -0700 Subject: [PATCH] Fix expected type when typechecking map (cherry picked from commit 863ac053328b0df54cc10a0724274f7d110d6d49) --- .../tests/typed-racket/unit-tests/typecheck-tests.rkt | 4 ++++ collects/typed-racket/typecheck/tc-app/tc-app-list.rkt | 9 ++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index b36f2957af..a928830f38 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1626,6 +1626,10 @@ (Listof Symbol))] [tc-e (filter values empty) (-lst -Bottom)] + [tc-e (lambda lst (map (plambda: (b) ([x : b]) x) lst)) + (-polydots (a) (->... (list) (a a) (make-ListDots a 'a))) + #:expected (ret (-polydots (a) (->... (list) (a a) (make-ListDots a 'a))))] + [tc-e ((inst filter Any Symbol) symbol? null) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt index 7c6fbcb39d..8c5d7bb2bd 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt @@ -42,12 +42,19 @@ ...)) (=> fail) (unless (for/and ([b bound]) (or (not b) (eq? bound0 b))) (fail)) + (define expected-elem-type + (match expected + [(or #f (tc-any-results:)) #f] + [(tc-result1: (ListDots: elem-type (== bound0))) (ret elem-type)] + [(tc-result1: (Listof: elem-type)) (ret elem-type)] + [else (fail)])) ;; Do not check this in an environment where bound0 is a type variable. (define f-type (tc-expr #'f)) ;; Check that the function applies successfully to the element type ;; We need the bound to be considered a type var here so that inference works (match (extend-tvars (list bound0) - (tc/funapp #'f #'(arg0 arg ...) f-type (cons (ret t0) (map ret t)) expected)) + (tc/funapp #'f #'(arg0 arg ...) f-type (cons (ret t0) (map ret t)) + expected-elem-type)) [(tc-result1: t) (ret (make-ListDots t bound0))] [(tc-results: ts) (tc-error/expr #:return (ret (Un))