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:
Matthew Flatt 2015-08-05 12:03:29 -06:00
parent 27fed2b1ed
commit 6bcb449b55
3 changed files with 27 additions and 4 deletions

View File

@ -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

View File

@ -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

View File

@ -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);