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"