From 7156b0391b2ff104289ea6eb9bcb21cf693c68a3 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 25 May 2012 09:13:35 -0500
Subject: [PATCH] fix the contract context messages for the case of ->*'s
 #:rest arguments

---
 collects/racket/contract/private/arrow.rkt |  7 ++++--
 collects/tests/racket/contract-test.rktl   | 27 +++++++++++++++++++++-
 2 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/collects/racket/contract/private/arrow.rkt b/collects/racket/contract/private/arrow.rkt
index 1a0e713ff6..60402da0b3 100644
--- a/collects/racket/contract/private/arrow.rkt
+++ b/collects/racket/contract/private/arrow.rkt
@@ -476,8 +476,11 @@ v4 todo:
         (for/list ([dom (in-list doms-proj)]
                    [n (in-naturals 1)])
           (dom (blame-add-context orig-blame 
-                                  (format "the ~a argument of"
-                                          (n->th n))
+                                  (if (and has-rest?
+                                           (n . > . dom-length))
+                                      "the rest argument of"
+                                      (format "the ~a argument of"
+                                              (n->th n)))
                                   #:swap? #t))))
       (define partial-optional-doms 
         (for/list ([dom (in-list doms-optional-proj)]
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index ba7cd637ff..92b9b9ee32 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -12728,7 +12728,7 @@ so that propagation occurs.
                           'neg)
                 #f)))
   
-    (ctest '("the range of") 
+  (ctest '("the range of") 
          extract-context-lines 
          (λ () ((contract (->d ([x integer?]) [y integer?])
                           (λ (x) #f)
@@ -12837,6 +12837,31 @@ so that propagation occurs.
                  0)
                 1)))
   
+  (ctest '("an element of" "the rest argument of")
+         extract-context-lines
+         (λ ()
+           ((contract (->* () #:rest (listof number?) number?)
+                      +
+                      'pos 'neg)
+            1 "a")))
+
+  (ctest '("the 2nd argument of")
+         extract-context-lines
+         (λ ()
+           ((contract (->* (number? number?) #:rest (listof number?) number?)
+                      +
+                      'pos 'neg)
+            1 "a")))
+
+  (ctest '("an element of" "the rest argument of")
+         extract-context-lines
+         (λ ()
+           ((contract (->* (number?) #:rest (listof number?) number?)
+                      +
+                      'pos 'neg)
+            1 "a")))
+
+  
   (let* ([blame-pos (contract-eval '(make-blame #'here #f (λ () 'integer?) 'positive 'negative #t))]
          [blame-neg (contract-eval `(blame-swap ,blame-pos))])
     (ctest "something ~a" blame-fmt->-string ,blame-neg "something ~a")