From 1cff0a1f85e30ca231cde5fa94ec2d8c47b74d68 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 11 Jun 2010 19:35:56 -0400 Subject: [PATCH] Actually typecheck actuals even when there's a type annotation. --- collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt | 5 ++++- collects/typed-scheme/typecheck/tc-app.rkt | 7 ++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index df5a9c17fe..93e88328f0 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -808,7 +808,10 @@ (vector-ref #("a" "b") (- x 1))) -String] [tc-err (string-append "bar" (if (zero? (ann 0.0 Float)) #f "foo"))] - ) + [tc-err (do: : Void + ([j : Natural (+ i 'a) (+ j i)]) + ((>= j 10)) + #f)]) (test-suite "check-type tests" (test-exn "Fails correctly" exn:fail:syntax? (lambda () (parameterize ([orig-module-stx #'here]) diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index 8d9e9bb9a2..d359b15fae 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -238,9 +238,10 @@ [_ (let ([ts (for/list ([ac (syntax->list actuals)] [f (syntax->list args)]) - (or - (type-annotation f #:infer #t) - (generalize (tc-expr/t ac))))]) + (let ([infer-t (type-annotation f #:infer #t)]) + (if infer-t + (check-below (tc-expr/t ac) infer-t) + (generalize (tc-expr/t ac)))))]) (tc/rec-lambda/check form args body lp ts expected) expected)]))