fixed promise/c so it creates chaperone contracts when its

argument is a chaperone contract

closes PR 12861

collects/racket/contract/private/misc.rkt

@@ -2,6 +2,7 @@
 
 (require (for-syntax racket/base)
          racket/promise
+         (only-in "../../private/promise.rkt" prop:force promise-forcer)
          "prop.rkt"
          "blame.rkt"
          "guts.rkt"
@@ -825,7 +826,8 @@
   (λ (ctc-in)
     (let* ([ctc (coerce-contract 'promise/c ctc-in)]
            [ctc-proc (contract-projection ctc)])
-      (make-contract
+      (define chap? (chaperone-contract? ctc))
+      ((if chap? make-chaperone-contract make-contract)
        #:name (build-compound-type-name 'promise/c ctc)
        #:projection
        (λ (blame)
@@ -837,7 +839,15 @@
                 val
                 '(expected "<promise>," given: "~e")
                 val))
-             (delay (p-app (force val))))))
+                   (if chap?
+                       (chaperone-struct
+                        val
+                        promise-forcer (λ (_ proc) 
+                                         (chaperone-procedure
+                                          proc
+                                          (λ (promise)
+                                            (values p-app promise)))))
+                       (delay (p-app (force val)))))))
        #:first-order promise?))))
 
 (define/subexpression-pos-prop (parameter/c x)

collects/racket/private/promise.rkt

@@ -8,6 +8,7 @@
 (#%provide force promise? promise-forced? promise-running?
            ;; provided to create extensions
            (struct promise ()) pref pset! prop:force reify-result
+           promise-forcer
            promise-printer
            (struct running ()) (struct reraise ())
            (for-syntax make-delayer))

collects/tests/racket/contract-test.rktl

@@ -9246,6 +9246,15 @@
       x)
    1)
   
+  (test/spec-passed/result
+   'promise/c5
+   '(let ([a (delay 7)])
+      (equal? a
+              (contract (promise/c integer?)
+                        a
+                        'pos
+                        'neg)))
+   #t)
 
   
 ;                                                                 
@@ -11355,6 +11364,9 @@ so that propagation occurs.
   (ctest #t flat-contract? (list/c integer?))
   (ctest #t chaperone-contract? (list/c (-> integer? integer?)))
   
+  (ctest #t chaperone-contract? (promise/c integer?))
+  (ctest #f chaperone-contract? (promise/c (new-∃/c 'alpha)))
+  
   ;; Make sure that impersonators cannot be used as the element contract in set/c.
   (contract-error-test
    'contract-error-test-set