diff --git a/pkgs/racket-doc/scribblings/reference/chaperones.scrbl b/pkgs/racket-doc/scribblings/reference/chaperones.scrbl index 21cee89b8a..747835735c 100644 --- a/pkgs/racket-doc/scribblings/reference/chaperones.scrbl +++ b/pkgs/racket-doc/scribblings/reference/chaperones.scrbl @@ -221,9 +221,11 @@ If any @racket[prop] is @racket[impersonator-prop:application-mark] and if the associated @racket[prop-val] is a pair, then the call to @racket[proc] is wrapped with @racket[with-continuation-mark] using @racket[(car prop-val)] as the mark key and @racket[(cdr prop-val)] as the mark -value. In addition, if @racket[continuation-mark-set-first] with -@racket[(car prop-val)] produces a value for the immediate -continuation frame of the call to the impersonated procedure, the value is +value. In addition, if the immediate +continuation frame of the call to the impersonated procedure +includes a value for @racket[(car prop-val)]---that is, if +@racket[call-with-immediate-continuation-mark] would produce a value +for @racket[(car prop-val)] in the call's continuation---then the value is also installed as an immediate value for @racket[(car prop-val)] as a mark during the call to @racket[wrapper-proc] (which allows tail-calls of impersonators with respect to wrapping impersonators to be detected within diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index b44fa58a5b..482e62d849 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -1883,6 +1883,27 @@ (f 42)) (test '(#f #f) values msgs)) +;; Make sure that `impersonator-prop:application-mark' +;; doesn't propagate for non-tail values: +(let () + (define msgs '()) + (define (wrap f) + (chaperone-procedure + f + (λ (x) + (call-with-immediate-continuation-mark + 'key + (λ (m) + (set! msgs (cons m msgs)) + (values x)))) + impersonator-prop:application-mark + (cons 'key 'skip-this-check))) + + (test 42 + values + ((wrap (lambda (x) (+ ((wrap (lambda (x) x)) x) 0))) 42)) + (test '(#f #f) values msgs)) + ;; ---------------------------------------- ;; Check that supplying a procedure `to make-keyword-procedure' that diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 5c727d4af2..a1f0002fe0 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -3691,7 +3691,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object app_mark = NULL; if (app_mark) { - v = scheme_extract_one_cc_mark(NULL, SCHEME_CAR(app_mark)); + v = scheme_chaperone_get_immediate_cc_mark(SCHEME_CAR(app_mark), NULL); if (v) { scheme_push_continuation_frame(&cframe); scheme_set_cont_mark(SCHEME_CAR(app_mark), v);