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]
|
associated @racket[prop-val] is a pair, then the call to @racket[proc]
|
||||||
is wrapped with @racket[with-continuation-mark] using @racket[(car
|
is wrapped with @racket[with-continuation-mark] using @racket[(car
|
||||||
prop-val)] as the mark key and @racket[(cdr prop-val)] as the mark
|
prop-val)] as the mark key and @racket[(cdr prop-val)] as the mark
|
||||||
value. In addition, if @racket[continuation-mark-set-first] with
|
value. In addition, if the immediate
|
||||||
@racket[(car prop-val)] produces a value for the immediate
|
continuation frame of the call to the impersonated procedure
|
||||||
continuation frame of the call to the impersonated procedure, the value is
|
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
|
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
|
mark during the call to @racket[wrapper-proc] (which allows tail-calls
|
||||||
of impersonators with respect to wrapping impersonators to be detected within
|
of impersonators with respect to wrapping impersonators to be detected within
|
||||||
|
|
|
@ -1883,6 +1883,27 @@
|
||||||
(f 42))
|
(f 42))
|
||||||
(test '(#f #f) values msgs))
|
(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
|
;; 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;
|
app_mark = NULL;
|
||||||
|
|
||||||
if (app_mark) {
|
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) {
|
if (v) {
|
||||||
scheme_push_continuation_frame(&cframe);
|
scheme_push_continuation_frame(&cframe);
|
||||||
scheme_set_cont_mark(SCHEME_CAR(app_mark), v);
|
scheme_set_cont_mark(SCHEME_CAR(app_mark), v);
|
||||||
|
|
Loading…
Reference in New Issue
Block a user