fix impersonator-property:application-mark
propagation
Propagate the mark value only if it's on the current continuation frame, as originally intended. Adjust the docs to clarify.
This commit is contained in:
parent
27fed2b1ed
commit
6bcb449b55
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue
Block a user