From d22a771c983fe428857e95a6edead97084f29860 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 9 Aug 2016 16:25:15 -0500
Subject: [PATCH] avoid dropping provide/contract-original-contract property

---
 .../tests/racket/contract/contract-out.rkt    | 42 ++++++++++++++++++-
 .../collects/racket/contract/private/out.rkt  |  4 +-
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
index df44088929..226d588e55 100644
--- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt
+++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
@@ -3,7 +3,7 @@
          (for-syntax racket/base))
 
 (parameterize ([current-contract-namespace
-                (make-basic-contract-namespace 'racket/contract)])
+                (make-basic-contract-namespace 'racket/contract 'racket/list)])
   
   (define exn:fail:contract:blame-object 
     (contract-eval 'exn:fail:contract:blame-object))
@@ -1457,5 +1457,45 @@
    (λ (x)
      (and (exn:fail:contract:blame? x)
           (regexp-match? #rx"blaming: bad1-client" (exn-message x)))))
+
+  (contract-eval
+   '(define (find-p/c-prop stx)
+      (define the-props
+        (flatten
+         (let loop ([stx stx])
+           (cond
+             [(syntax? stx)
+              (cons (syntax-property stx 'provide/contract-original-contract)
+                    (loop (syntax-e stx)))]
+             [(pair? stx)
+              (cons (loop (car stx)) (loop (cdr stx)))]
+             [else '()]))))
+      (remove-duplicates
+       (for/list ([e (in-list the-props)]
+                  #:when e)
+         (syntax->datum (vector-ref e 1))))))
+  
+  (test/spec-passed/result
+   'provide/contract.prop1
+   '(let ()
+      (find-p/c-prop
+       (expand
+        '(module test racket
+            (provide/contract
+             [x (>/c 5)])
+            (define x 6)))))
+   (list '(>/c 5)))
+
+  (test/spec-passed/result
+   'provide/contract.prop2
+   '(let ()
+      (find-p/c-prop
+       (expand
+        '(module test racket
+            (provide
+             (contract-out
+              [x (>/c 5)]))
+            (define x 6)))))
+   (list '(>/c 5)))
   
   )
diff --git a/racket/collects/racket/contract/private/out.rkt b/racket/collects/racket/contract/private/out.rkt
index 65f25afdd8..8c32ca56af 100644
--- a/racket/collects/racket/contract/private/out.rkt
+++ b/racket/collects/racket/contract/private/out.rkt
@@ -38,7 +38,9 @@
          (let loop ([stx (true-provide/contract #'orig-stx #f 'contract-out)])
            (syntax-case stx (begin provide)
              [(begin args ...)
-              #`(begin #,@(map loop (syntax->list #'(args ...))))]
+              (syntax-property #`(begin #,@(map loop (syntax->list #'(args ...))))
+                               'provide/contract-original-contract
+                               (syntax-property stx 'provide/contract-original-contract))]
              [(provide clause ...)
               (identifier? #'x)
               (begin (set! provide-clauses (append (syntax->list #'(clause ...))