fix chaperone-contract? on opt/c-produced contracts

collects/racket/contract/private/misc.rkt

@@ -906,7 +906,9 @@
 (define (chaperone-contract? x)
   (let ([c (coerce-contract/f x)])
     (and c
-         (chaperone-contract-struct? c))))
+         (or (chaperone-contract-struct? c)
+             (and (prop:opt-chaperone-contract? c)
+                  ((prop:opt-chaperone-contract-get-test c) c))))))
 
 (define (impersonator-contract? x)
   (let ([c (coerce-contract/f x)])

collects/racket/contract/private/opt.rkt

@@ -228,7 +228,8 @@
               (λ () e)
               (λ (this that) #f)
               (vector)
-              (begin-lifted (box #f)))))))]))
+              (begin-lifted (box #f))
+              #,chaperone?)))))]))
 
 ;; this macro optimizes 'e' as a contract,
 ;; using otherwise-id if it does not recognize 'e'.
@@ -320,7 +321,8 @@
                       (λ () e)
                       (λ (this that) #f)
                       (vector)
-                      (begin-lifted (box #f))))))
+                      (begin-lifted (box #f))
+                      #,chaperone?))))
              (values f1 f2))))]))
 
 ;; optimized contracts
@@ -333,13 +335,12 @@
 (define-values (orig-ctc-prop orig-ctc-pred? orig-ctc-get)
   (make-struct-type-property 'original-contract))
 
-(define-struct opt-contract (proj orig-ctc stronger stronger-vars stamp)
+(define-struct opt-contract (proj orig-ctc stronger stronger-vars stamp chaperone?)
   #:property orig-ctc-prop (λ (ctc) ((opt-contract-orig-ctc ctc)))
+  #:property prop:opt-chaperone-contract (λ (ctc) (opt-contract-chaperone? ctc))
   #:property prop:contract
   (build-contract-property
    #:projection (λ (ctc) ((opt-contract-proj ctc) ctc))
-   ;; I think provide/contract and contract calls this, so we are in effect allocating
-   ;; the original once
    #:name (λ (ctc) (contract-name ((orig-ctc-get ctc) ctc)))
    #:stronger
    (λ (this that)

collects/racket/contract/private/prop.rkt

@@ -31,7 +31,11 @@
          make-chaperone-contract
          make-flat-contract
          
-         skip-projection-wrapper?)
+         skip-projection-wrapper?
+         
+         prop:opt-chaperone-contract
+         prop:opt-chaperone-contract? 
+         prop:opt-chaperone-contract-get-test)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -126,6 +130,15 @@
    chaperone-contract-property-guard
    (list (cons prop:contract chaperone-contract-property->contract-property))))
 
+;; this property is so the opt'd contracts can
+;; declare that they are chaperone'd; the property
+;; is a function that extracts a boolean from the 
+;; original struct
+(define-values (prop:opt-chaperone-contract
+                prop:opt-chaperone-contract? 
+                prop:opt-chaperone-contract-get-test)
+  (make-struct-type-property 'prop:opt-chaperone-contract))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  Flat Contract Property