From 328956e8b5cd9b9c6256b1eac4f46aec98ce2a5d Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 5 Jul 2013 17:41:17 -0400
Subject: [PATCH] Fix type error reporting for case-> with * domains

In the case that a case-> type included a case with a *
domain and had additional branches, a use of `apply` with
that type would fail to report a type error. This was
because the type of the applied list was ignored for type
error generation.

Closes PR 13893
---
 .../typed-racket/typecheck/tc-app-helper.rkt  |  5 +++--
 .../tests/typed-racket/fail/pr13893.rkt       | 21 +++++++++++++++++++
 2 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/fail/pr13893.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
index 7de04b062f..0c735ff0d4 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
@@ -101,7 +101,6 @@
 (define (domain-mismatches f-stx args-stx ty doms rests drests rngs arg-tys tail-ty tail-bound
                            #:expected [expected #f] #:return [return -Bottom]
                            #:msg-thunk [msg-thunk (lambda (dom) dom)])
-
   (define arguments-str
     (stringify-domain arg-tys
                       (if (not tail-bound) tail-ty #f)
@@ -155,7 +154,9 @@
                        (if (null? pdoms)
                            (values doms rngs rests drests)
                            (values pdoms prngs prests pdrests))])
-           (if (= (length pdoms) 1)
+           (if ;; only use `tc/funapp1` if `tail-ty` was *not* provided
+               ;; since it either won't error correctly or produces a poor error
+               (and (not tail-ty) (= (length pdoms) 1))
                ;; if we narrowed down the possible cases to a single one, have
                ;; tc/funapp1 generate a better error message
                (begin (tc/funapp1 f-stx args-stx
diff --git a/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/fail/pr13893.rkt b/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/fail/pr13893.rkt
new file mode 100644
index 0000000000..376187b647
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/fail/pr13893.rkt
@@ -0,0 +1,21 @@
+#;
+(exn:pred #rx"Bad arguments to function in apply")
+#lang typed/racket
+
+;; Make sure that case-> types with multiple branches that
+;; includes a * domain produce a type error instead of
+;; accidentally type-checking.
+
+;; from the PR
+(: x (Listof Number))
+(define x (apply + (list 1 2 "3")))
+
+(: g (-> (Listof Number)))
+(define (g) (apply + (list 1 2 "3")))
+
+;; additional case
+(: f (case-> (Integer * -> Integer)
+             (Real * -> Real)))
+(define (f . args) (+ 1 (list-ref args 2)))
+(apply f (list 1 2 "3"))
+