diff --git a/pkgs/racket-test/tests/racket/contract/parameter.rkt b/pkgs/racket-test/tests/racket/contract/parameter.rkt index a96ab1e63d..c353250c8d 100644 --- a/pkgs/racket-test/tests/racket/contract/parameter.rkt +++ b/pkgs/racket-test/tests/racket/contract/parameter.rkt @@ -65,6 +65,16 @@ (contract (parameter/c integer?) p 'pos 'neg) p)) + #f) + + (test/spec-passed/result + 'parameter/c9b + '(let ([p (make-parameter (λ (x) x))]) + (chaperone-of? + (contract (parameter/c (-> integer? integer?) + #:impersonator? #f) + p 'pos 'neg) + p)) #t) (test/spec-passed/result @@ -101,7 +111,7 @@ (parameter/c (-> integer? integer?) #:impersonator? #f)) #t) - + (test/spec-passed/result 'parameter/c13 '(chaperone-contract? diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt index b346c3737e..f8b2386266 100644 --- a/racket/collects/racket/contract/private/misc.rkt +++ b/racket/collects/racket/contract/private/misc.rkt @@ -480,7 +480,7 @@ [else (impersonator-parameter/c in-ctc out-ctc/f)])) -(define (parameter/c-lnp ctc) +(define ((parameter/c-lnp chaperone-or-impersonate-procedure) ctc) (define in-proc (get/build-late-neg-projection (base-parameter/c-in ctc))) (define out-proc (if (base-parameter/c-out/f ctc) (get/build-late-neg-projection (base-parameter/c-out/f ctc)) @@ -493,7 +493,7 @@ (define blame+neg-party (cons blame/c neg-party)) (cond [(parameter? val) - (chaperone-procedure + (chaperone-or-impersonate-procedure val (case-lambda [(x) @@ -565,7 +565,7 @@ #:property prop:contract (build-contract-property #:trusted trust-me - #:late-neg-projection parameter/c-lnp + #:late-neg-projection (parameter/c-lnp impersonate-procedure) #:name parameter/c-name #:first-order parameter/c-first-order #:stronger parameter/c-stronger @@ -575,7 +575,7 @@ #:property prop:chaperone-contract (build-chaperone-contract-property #:trusted trust-me - #:late-neg-projection parameter/c-lnp + #:late-neg-projection (parameter/c-lnp chaperone-procedure) #:name parameter/c-name #:first-order parameter/c-first-order #:stronger parameter/c-stronger