From 84c0208d997cff07ffd70c12a97d044c48482c2e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 7 Jan 2013 09:24:31 -0600
Subject: [PATCH] add check for number of result values in ->i (that signals
 blame)

closes PR 13417
---
 collects/racket/contract/private/arr-i.rkt | 23 +++++++++++++---------
 collects/tests/racket/contract-test.rktl   | 16 +++++++++++++++
 2 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/collects/racket/contract/private/arr-i.rkt b/collects/racket/contract/private/arr-i.rkt
index 81a40faf0b..ad7c5b2274 100644
--- a/collects/racket/contract/private/arr-i.rkt
+++ b/collects/racket/contract/private/arr-i.rkt
@@ -516,15 +516,20 @@
   (cond
     [(istx-ress an-istx)
      (list
-      #`(λ #,(vector->list wrapper-ress)
-          #,(add-wrapper-let 
-             (add-post-cond an-istx arg/res-to-indy-var #`(values #,@(vector->list wrapper-ress)))
-             #f
-             ordered-ress res-indices
-             res-proj-vars indy-res-proj-vars 
-             wrapper-ress indy-res-vars
-             arg/res-to-indy-var
-             blame-var-table)))]
+      #`(case-lambda
+          [#,(vector->list wrapper-ress)
+           #,(add-wrapper-let 
+              (add-post-cond an-istx arg/res-to-indy-var #`(values #,@(vector->list wrapper-ress)))
+              #f
+              ordered-ress res-indices
+              res-proj-vars indy-res-proj-vars 
+              wrapper-ress indy-res-vars
+              arg/res-to-indy-var
+              blame-var-table)]
+          [args
+           (bad-number-of-results blame val
+                                  #,(vector-length wrapper-ress)
+                                  args)]))]
     [else
      null]))
 
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 7922124a60..c3daa0bfea 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -3325,6 +3325,22 @@
       x)
    '(body ctc))
 
+  (test/pos-blame
+   '->i-bad-number-of-result-values1
+   '((contract (->i ((x any/c)) (result (x) any/c))
+               (λ (x) (values 1 2))
+               'pos
+               'neg)
+     1))
+
+  (test/pos-blame
+   '->i-bad-number-of-result-values2
+   '((contract (->i ((giraffe any/c)) (elephant any/c))
+               (λ (x) (values 1 2))
+               'pos
+               'neg)
+     1))
+  
 ;
 ;
 ;