From 44073e31b431f414ae4daae758aa6d22638a4575 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 1 Jan 2015 09:56:00 -0600
Subject: [PATCH] add missing neg-party

closes PR 14915
---
 pkgs/racket-test/tests/racket/contract/arrow.rkt            | 6 ++++++
 .../collects/racket/contract/private/arrow-higher-order.rkt | 3 ++-
 racket/collects/racket/contract/private/arrow.rkt           | 4 +++-
 racket/collects/racket/contract/private/blame.rkt           | 3 ++-
 4 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt
index 44a7400c33..4876bc1233 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt
@@ -50,6 +50,12 @@
                'neg)
      1))
   
+  (test/neg-blame
+   'contract-arrow-values6
+   '(((contract (-> (-> (listof integer?)) any)
+                (λ (x) x)
+                'pos 'neg)
+      (λ () (values 1 2)))))
   
   (test/pos-blame
    'contract-arrow-keyword1
diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index ecdbfaf845..c0994902ee 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -169,7 +169,8 @@
                                         post ...
                                         rng-results))]
                                     [args
-                                     (arrow:bad-number-of-results blame val rng-len args)]))))
+                                     (arrow:bad-number-of-results blame val rng-len args
+                                                                  #:missing-party neg-party)]))))
                            null)])
           (let* ([min-method-arity (length doms)]
                  [max-method-arity (+ min-method-arity (length opt-doms))]
diff --git a/racket/collects/racket/contract/private/arrow.rkt b/racket/collects/racket/contract/private/arrow.rkt
index 9a44fad451..0f41b86842 100644
--- a/racket/collects/racket/contract/private/arrow.rkt
+++ b/racket/collects/racket/contract/private/arrow.rkt
@@ -1713,12 +1713,14 @@
     [else
      passes?]))
 
-(define (bad-number-of-results blame val rng-len args [case-context #f])
+(define (bad-number-of-results blame val rng-len args [case-context #f]
+                               #:missing-party [missing-party #f])
   (define num-values (length args))
   (define blame-case (if case-context 
                          (blame-add-context blame (format "the ~a case of" (n->th (+ case-context 1))))
                          blame))
   (raise-blame-error (blame-add-range-context blame-case)
+                     #:missing-party missing-party
                      val 
                      "expected ~a value~a, returned ~a value~a"
                      rng-len (if (= rng-len 1) "" "s")
diff --git a/racket/collects/racket/contract/private/blame.rkt b/racket/collects/racket/contract/private/blame.rkt
index ccfcfe28ab..2a2a997fed 100644
--- a/racket/collects/racket/contract/private/blame.rkt
+++ b/racket/collects/racket/contract/private/blame.rkt
@@ -247,7 +247,8 @@
   (unless (blame-positive blme)
     (raise-argument-error 'default-blame-format
                           "a blame object with a non-#f positive field"
-                          blme))
+                          0
+                          blme x custom-message))
   
   (define source-message (source-location->string (blame-source blme)))