From b63e5dc1ec68f700bdbe2651924fcec762c0af72 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Tue, 19 Feb 2013 23:03:12 -0800 Subject: [PATCH] Avoid TR internal error, by checking shape of args. original commit: 1fd21ef640514b0c3a67356d0f68cadff36d3d3a --- collects/tests/typed-racket/unit-tests/typecheck-tests.rkt | 2 +- collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index de64b3ad..084e8a60 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1601,7 +1601,7 @@ [tc-e (vector-split-at (vector 2 3 4 5 6) 3) (list (-vec -Integer) (-vec -Integer))] - + [tc-e/t (ann ((letrec ((x (lambda args 3))) x) 1 2) Byte) -Byte] ) (test-suite "check-type tests" diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt index 0f632f30..13180d86 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt @@ -20,11 +20,11 @@ (define-tc/app-syntax-class (tc/app-lambda expected) #:literals (#%plain-app #%plain-lambda letrec-values) ;; let loop - (pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda args . body))]) lp*) . actuals) + (pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda (args ...) . body))]) lp*) . actuals) #:fail-unless expected #f - #:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f + #:fail-unless (not (andmap type-annotation (syntax->list #'(lp args ...)))) #f #:fail-unless (free-identifier=? #'lp #'lp*) #f - (let-loop-check #'lam #'lp #'actuals #'args #'body expected)) + (let-loop-check #'lam #'lp #'actuals #'(args ...) #'body expected)) ;; inference for ((lambda (pattern ((#%plain-lambda (x ...) . body) args ...) #:fail-unless (= (length (syntax->list #'(x ...)))