From 6723c64487869165e5f1645ba14a673b2ec70040 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 25 Jan 2016 23:51:38 -0600
Subject: [PATCH] dont use unsafe-{chaperone,impersonator}-procedure when
 {chaperone,impersonator}-procedure* might be involved

---
 .../tests/racket/contract/arrow.rkt           | 21 +++++++++++++++++++
 .../racket/contract/private/arrow.rkt         |  4 ++++
 2 files changed, 25 insertions(+)

diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt
index 6f0f719b55..dae842be92 100644
--- a/pkgs/racket-test/tests/racket/contract/arrow.rkt
+++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt
@@ -378,6 +378,27 @@
          'pos 'neg)
         'something-else 'yet-another-thing)
        1)))
+
+  (test/spec-passed/result
+   'chaperone-procedure*-and-contract-interaction
+   '(let ()
+      (define (f1 x) x)
+      
+      (define-values (prop:p prop:p? prop:get-p)
+        (make-impersonator-property 'p))
+      
+      (define the-answer 'dont-know)
+      
+      (define f2 (chaperone-procedure*
+                  f1
+                  (λ (f x)
+                    (set! the-answer (and (prop:p? f) (prop:get-p f)))
+                    x)))
+      (define f3 (contract (-> integer? integer?) f2 'pos 'neg))
+      (define f4 (chaperone-procedure f3 #f prop:p 1234))
+      (f4 1)
+      the-answer)
+   1234)
   
   (test/pos-blame
    'predicate/c1
diff --git a/racket/collects/racket/contract/private/arrow.rkt b/racket/collects/racket/contract/private/arrow.rkt
index dc5a07914e..c4dd6bafbe 100644
--- a/racket/collects/racket/contract/private/arrow.rkt
+++ b/racket/collects/racket/contract/private/arrow.rkt
@@ -460,6 +460,10 @@
     [(matches-arity-exactly? val min-arity max-arity req-kwd opt-kwd)
      (if (and (null? req-kwd) (null? opt-kwd))
          (cond
+           [(impersonator? val)
+            (if basic-unsafe-lambda
+                (values basic-lambda #f)
+                basic-lambda)]
            [(and basic-unsafe-lambda
                  basic-unsafe-lambda/result-values-assumed
                  (equal? contract-result-val-count