From fcb558d2b13c096dcdbc8487b96cc4b5f9c30330 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Fri, 25 Apr 2014 21:30:38 -0700
Subject: [PATCH] Fix apply with (Listof A) args.

Closes PR 14465.

original commit: b42e0d8d68f19c4cc80bb23f1cb1a383edeba322
---
 .../typed-racket/typecheck/tc-apply.rkt         | 17 +++++++++++++----
 .../typed-racket/unit-tests/typecheck-tests.rkt |  7 +++++++
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
index 68a25897..d7f04441 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
@@ -203,15 +203,24 @@
                                 (cons (make-ListDots (car (car drests*)) (cdr (car drests*))) (car doms*))
                                 (car rngs*)))))
                 => finish]
-               ;; ... function, (List A B C etc) arg
+               ;; ... function, (Listof A) or (List A B C etc) arg
                [(and (car drests*)
                      (not tail-bound)
                      (eq? (cdr (car drests*)) dotted-var)
                      (= (length (car doms*))
                         (length arg-tys))
-                     (untuple tail-ty)
-                     (infer/dots fixed-vars dotted-var (append arg-tys (untuple tail-ty)) (car doms*)
-                                 (car (car drests*)) (car rngs*) (fv (car rngs*))))
+                     (match tail-ty
+                       [(Listof: tail-arg-ty)
+                        (infer/vararg
+                          fixed-vars (list dotted-var)
+                          (cons tail-arg-ty arg-tys)
+                          (cons (car (car drests*)) (car doms*))
+                          (car rests*)
+                          (car rngs*))]
+                       [(List: tail-arg-tys)
+                        (infer/dots fixed-vars dotted-var (append arg-tys tail-arg-tys) (car doms*)
+                                    (car (car drests*)) (car rngs*) (fv (car rngs*)))]
+                       [_ #f]))
                 => finish]
                ;; if nothing matches, around the loop again
                [else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
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 78fc3edd..83571218 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
@@ -2825,6 +2825,13 @@
        [tc-err (string-append (typecheck-fail #'stx "typecheck-fail") "bar")
                #:ret (ret -String)
                #:msg #rx"typecheck-fail"]
+
+       [tc-e
+         (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
+           (lambda xs (apply f xs)))
+         #:ret (ret (->* (list) Univ Univ))
+         #:expected (ret (->* (list)  Univ Univ))]
+
         )
   (test-suite
    "tc-literal tests"