From 71f338430bcbf64ebb5c2598afb69aa8bf5f379d Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 10 Feb 2016 17:35:46 -0600
Subject: [PATCH] clean up some confusion about the timing of errors

specifically, always wait for the neg party to come in
before signalling any errors
---
 .../tests/racket/contract/contract-out.rkt    | 13 ++++++++++
 .../contract/private/arity-checking.rkt       | 19 ++++-----------
 .../contract/private/arrow-higher-order.rkt   | 24 +++++++++++--------
 3 files changed, 32 insertions(+), 24 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
index 19d0382670..df44088929 100644
--- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt
+++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
@@ -1068,6 +1068,19 @@
                (define a (s-x (chaperone-struct an-s s-x (λ (s x) x))))))
       (eval '(dynamic-require ''provide/contract55-m2 'a)))
    '5)
+
+  (test/spec-failed
+   'provide/contract56
+   '(let ()
+      (eval '(module provide/contract56-m1 racket/base
+               (require racket/contract/base)
+               (provide
+                (contract-out
+                 [f (-> integer? integer?)]))
+               (define f 1)))
+      (eval '(dynamic-require ''provide/contract56-m1 #f)))
+   "provide/contract56-m1")
+   
   
   (contract-error-test
    'contract-error-test8
diff --git a/racket/collects/racket/contract/private/arity-checking.rkt b/racket/collects/racket/contract/private/arity-checking.rkt
index b22b893e2d..7f3bb9d7b7 100644
--- a/racket/collects/racket/contract/private/arity-checking.rkt
+++ b/racket/collects/racket/contract/private/arity-checking.rkt
@@ -15,8 +15,7 @@
                            ->stct-kwd-infos)
   (let/ec k
     (unless (procedure? val)
-      (maybe-err 
-       k blame
+      (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
                             '(expected: "a procedure" given: "~e")
@@ -37,8 +36,7 @@
                        (<= (arity-at-least-value lst) ->stct-min-arity)))
                 #t)))
      (unless matching-arity?
-       (maybe-err
-        k blame
+       (k
         (λ (neg-party)
           (raise-blame-error blame #:missing-party neg-party val
                              '(expected: 
@@ -54,8 +52,7 @@
                              (arity-as-string val)))))
     
     (define (should-have-supplied kwd)
-      (maybe-err
-       k blame
+      (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
                             '(expected: 
@@ -67,8 +64,7 @@
                             (arity-as-string val)))))
     
     (define (should-not-have-supplied kwd)
-      (maybe-err
-       k blame
+      (k
        (λ (neg-party)
          (raise-blame-error blame #:missing-party neg-party val
                             '(expected: 
@@ -107,8 +103,7 @@
              [(equal? kwd (kwd-info-kwd kwd-info))
               (when (and (not (kwd-info-mandatory? kwd-info))
                          mandatory?)
-                (maybe-err
-                 k blame
+                (k
                  (λ (neg-party)
                    (raise-blame-error 
                     blame #:missing-party neg-party val
@@ -224,7 +219,3 @@
            (cons (format "~a, " (car kwds))
                  (loop (cdr kwds)))])))]))
 
-(define (maybe-err k blame neg-accepter)
-  (if (blame-original? blame)
-      (neg-accepter #f)
-      (k neg-accepter)))
diff --git a/racket/collects/racket/contract/private/arrow-higher-order.rkt b/racket/collects/racket/contract/private/arrow-higher-order.rkt
index 32ff89deda..fae0ce4b94 100644
--- a/racket/collects/racket/contract/private/arrow-higher-order.rkt
+++ b/racket/collects/racket/contract/private/arrow-higher-order.rkt
@@ -548,17 +548,21 @@
        (define (arrow-higher-order:vfp val)
          (define-values (normal-proc proc-with-no-result-checking expected-number-of-results)
            (apply plus-one-arity-function orig-blame val plus-one-constructor-args))
-         (wrapped-extra-arg-arrow 
-          (cond
-            [(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
-             =>
-             values]
-            [else
+         (cond
+           [(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
+            =>
+            (λ (neg-party-acceptor)
+              ;; probably don't need to include the wrapped-extra-arrow wrapper
+              ;; here, but it is easier to reason about the contract-out invariant
+              ;; with it here
+              (wrapped-extra-arg-arrow neg-party-acceptor normal-proc))]
+           [else
+            (wrapped-extra-arg-arrow
              (λ (neg-party)
-               (successfully-got-the-right-kind-of-function val neg-party))])
-          (if (equal? (procedure-result-arity val) expected-number-of-results)
-              proc-with-no-result-checking
-              normal-proc)))
+               (successfully-got-the-right-kind-of-function val neg-party))
+             (if (equal? (procedure-result-arity val) expected-number-of-results)
+                 proc-with-no-result-checking
+                 normal-proc))]))
        (if okay-to-do-only-arity-check?
            (λ (val)
              (cond