From a42b7a07928000807876299530693f5cf6c91cd2 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Tue, 13 May 2014 22:58:44 -0700
Subject: [PATCH] Make inst fail on results that are not single valued.

original commit: 62ff915a56694203bd22b91d7eb69dfeba5bbc51
---
 .../typed-racket/typecheck/tc-expression.rkt      | 15 +++++----------
 .../typed-racket/unit-tests/typecheck-tests.rkt   |  9 +++++++++
 2 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
index ed0bd483..30275404 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expression.rkt
@@ -42,23 +42,18 @@
 (define (do-inst tc-res inst)
   (define inst-type
     (if (row-syntax? inst) do-row-inst do-normal-inst))
-  (define (error-case tys)
+  (define (error-case number)
     (tc-error/expr
       "Cannot instantiate expression that produces ~a values"
-      (if (null? tys) 0 "multiple")))
+      number))
   (match tc-res
     [(tc-results: tys fs os)
      (match tys
       [(list ty)
        (ret (list (inst-type ty inst)) fs os)]
-      [_
-       (error-case tys)])]
-    [(tc-results: tys fs os dty dbound)
-     (match tys
-      [(list ty)
-       (ret (list (inst-type ty inst)) fs os dty dbound)]
-      [_
-       (error-case tys)])]))
+      [_ (error-case (if (null? tys) 0 "multiple"))])]
+    [_ (error-case "multiple")]))
+
 
 ;; row-syntax? Syntax -> Boolean
 ;; This checks if the syntax object resulted from a row instantiation
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 8e54a7f0..2fb16971 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
@@ -2969,6 +2969,15 @@
            (ret (-polydots (a ...)
                   (->... (list) (a a) (-values (list
                                         (t:-> Univ (-values-dots (list) (t:-> Univ -Boolean : (-FS (-filter -Symbol (list 1 0)) -top)) 'a)))))))]
+
+       [tc-err
+         (inst (eval '3) Any)
+         #:ret (ret -Bottom)]
+       [tc-err
+         (lambda xs (inst (apply values (plambda: (b) ([x : b]) x) xs) Symbol))
+         #:ret (ret (-polydots (a ...) (->... (list) (a a) (-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))
+         #:expected (ret (-polydots (a ...) (->... (list) (a a) (-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))]
+
         )
   (test-suite
    "tc-literal tests"