From 933e571125bda9736f35d66f9281018a8a5b4a60 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 10 Dec 2014 17:53:46 -0500 Subject: [PATCH] =?UTF-8?q?Don't=20compare=20non-identifiers=20with=20`fre?= =?UTF-8?q?e-id=3D=3F`.?= Closes PR 14877. --- .../typed-racket/typecheck/tc-app/tc-app-lambda.rkt | 4 ++-- .../tests/typed-racket/unit-tests/typecheck-tests.rkt | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt index 4a0c2a86..fdd0a64f 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt @@ -24,7 +24,7 @@ (define-tc/app-syntax-class (tc/app-lambda expected) #:literal-sets (kernel-literals) ;; 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*:id) . actuals) #:when expected #:when (not (andmap type-annotation (syntax->list #'(lp args ...)))) #:when (free-identifier=? #'lp #'lp*) @@ -59,7 +59,7 @@ (syntax-parse #`(#,args #,body #,actuals) #:literal-sets (kernel-literals lambda-literals) [((val acc ...) - ((~and inner-body (if (#%plain-app (~or pair? null?) val*) thn els))) + ((~and inner-body (if (#%plain-app (~or pair? null?) val*:id) thn els))) (actual actuals ...)) #:when (and (free-identifier=? #'val #'val*) diff --git a/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 3cc0c05a..7c8d94e6 100644 --- a/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -3350,6 +3350,10 @@ (ann (values a a) (Values Symbol Symbol))) (void)) -Void] + + [tc-e ((letrec ((loop (lambda: ([x : (Listof Integer)]) (cond ((null? (cdr x)) #t) (else #f))))) loop) + (list 1 2)) + -Boolean] ) (test-suite