suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

{chaperone,impersonate}-procedure*: fix argument propagation

Browse Source 
Fix the "self" argument propagation through an impersonator that has
no redirection function (but that probably has impersonator
properties).

Closes PR 14852
This commit is contained in:
Matthew Flatt 2014-11-24 16:00:02 -07:00
parent ac5961eae9
commit d0b94f48e0
2 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
View File

@ -253,18 +253,24 @@
(err/rt-test ((chaperone-procedure (lambda (x) x) (lambda (y) (values (lambda (z) 89) y))) 10))
(test 88 (impersonate-procedure* (lambda (x) x) (lambda (self y) 88)) 10)
(letrec ([final (impersonate-procedure*
(impersonate-procedure
(impersonate-procedure* (lambda (x) x)
(lambda (self y)
(test #t eq? self final)
(add1 y)))
(lambda (y)
(add1 y)))
(lambda (self y)
(test #t eq? self final)
(add1 y)))])
(test 13 final 10))
(let-values ([(prop:blue blue? blue-ref) (make-impersonator-property 'blue)])
(letrec ([final (impersonate-procedure*
(impersonate-procedure
(impersonate-procedure
(impersonate-procedure* (lambda (x) x)
(lambda (self y)
(test #t eq? self final)
(test 'whale blue-ref self)
(add1 y)))
(lambda (y)
(add1 y)))
#f
prop:blue
'whale)
(lambda (self y)
(test #t eq? self final)
(add1 y)))])
(test 13 final 10)))
(letrec ([final (impersonate-procedure*
(impersonate-procedure
(impersonate-procedure* (lambda (x) x)

4
racket/src/racket/src/fun.c
View File

@ -3627,6 +3627,10 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
if (SCHEME_FALSEP(SCHEME_VEC_ELS(px->redirects)[0])) {
/* no redirection procedure */
if (SCHEME_CHAPERONEP(px->prev)) {
/* commuincate `self_proc` to the next layer: */
scheme_current_thread->self_for_proc_chaperone = self_proc;
}
return _scheme_tail_apply(px->prev, argc, argv);
}