avoid dropping provide/contract-original-contract property

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)))
   
   )

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 ...))