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

impersonated mutator: fix internal stack overflow

Browse Source 
This is not a new bug, but it was exposed by the interaction
of the changed to the impersonated-mutator protocol and
the `unstable/option` test suite.
This commit is contained in:
Matthew Flatt 2014-10-21 13:41:02 -06:00
parent d81f09d11e
commit 8a45f9d341
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1252,6 +1252,22 @@
;; ----------------------------------------
;; Check internal stack-overflow handling:
(let ()
(define-struct a (x [y #:mutable]))
(let* ([a1 (make-a 1 2)]
[a2 (impersonate-struct a1 set-a-y!
(lambda (s v)
(if (zero? v)
v
(let ([v (sub1 v)])
(set-a-y! s v)
v))))])
(set-a-y! a2 100000)
(test 99999 a-y a1)))
;; ----------------------------------------
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let ()

43
racket/src/racket/src/struct.c
View File

@ -2154,11 +2154,54 @@ Scheme_Object *scheme_struct_ref(Scheme_Object *sv, int pos)
}
}
static void chaperone_struct_set(const char *who, Scheme_Object *prim,
Scheme_Object *o, int i, Scheme_Object *v);
static Scheme_Object *chaperone_struct_set_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *o = (Scheme_Object *)p->ku.k.p1;
Scheme_Object *prim = (Scheme_Object *)p->ku.k.p3;
const char *who = (const char *)p->ku.k.p2;
Scheme_Object *v = (Scheme_Object *)p->ku.k.p4;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
p->ku.k.p4 = NULL;
chaperone_struct_set(who, prim, o, p->ku.k.i1, v);
return scheme_false;
}
static void chaperone_struct_set_overflow(const char *who, Scheme_Object *prim,
Scheme_Object *o, int i, Scheme_Object *v)
{
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)o;
p->ku.k.p2 = (void *)who;
p->ku.k.p3 = (void *)prim;
p->ku.k.p4 = (void *)v;
p->ku.k.i1 = i;
(void)scheme_handle_stack_overflow(chaperone_struct_set_k);
}
static void chaperone_struct_set(const char *who, Scheme_Object *prim,
Scheme_Object *o, int i, Scheme_Object *v)
{
Scheme_Object *orig_o = o;
#ifdef DO_STACK_CHECK
# include "mzstkchk.h"
{
chaperone_struct_set_overflow(who, prim, o, i, v);
return;
}
#endif
while (1) {
if (!SCHEME_CHAPERONEP(o)) {
((Scheme_Structure *)o)->slots[i] = v;