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

repairs for {impersonator,chaperone}-struct

Browse Source 
Commit 0b71b8481d didn't have the tests that I thought I had
written, and so the changes were unsurprisingly buggy.
This commit is contained in:
Matthew Flatt 2014-10-21 20:46:13 -06:00
parent 2d422da25a
commit d9f2a84951
2 changed files with 51 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -584,7 +584,42 @@
(err/rt-test (a-x a3)))
(begin
(test 'bad a-x a2)
(test 'bad a-x a3)))))))
(test 'bad a-x a3)))))
(let* ([a1 (make-a 0 1)]
[a2 (chaperone-struct a1
a-x #f
set-a-x! #f
prop:blue 'blue)]
[a3 (chaperone-struct a1
set-a-x! #f
prop:blue 'cyan)])
(test #f eq? a1 a2)
(test #f eq? a1 a3)
(test #t eq? a1 (chaperone-struct a1
a-x #f
set-a-x! #f))
(test #t eq? a1 (chaperone-struct a1
set-a-x! #f))
(test 0 a-x a2)
(test (void) set-a-x! a2 1)
(test 1 a-x a2)
(test 'blue blue-ref a2)
(test 'cyan blue-ref a3))
(when is-chaperone
(let* ([p1 (make-p 0)]
[p2 (chaperone-struct p1
p-u #f
green-ref #f
prop:blue 'blue)])
(test #t eq? p1 (chaperone-struct p1
p-u #f
green-ref #f))
(test #t eq? p1 (chaperone-struct p1
p-u #f))
(test #t eq? p1 (chaperone-struct p1
p-u #f))
(test 0 p-u p2)
(test 'green green-ref p2)))))
;; test to see if the guard is actually called even when impersonated
(let ()

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

@ -5800,7 +5800,7 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
const char *kind;
Scheme_Hash_Tree *props = NULL, *red_props = NULL, *empty_red_props = NULL, *setter_positions = NULL;
intptr_t field_pos;
int empty_si_chaperone = 0, *empty_redirects = NULL;
int empty_si_chaperone = 0, *empty_redirects = NULL, has_redirect = 0;
if (argc == 1) return argv[0];
@ -5995,27 +5995,32 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
}
if (prop) {
if (SCHEME_TRUEP(prop)) {
if (SCHEME_TRUEP(proc)) {
if (!red_props)
red_props = scheme_make_hash_tree(0);
red_props = scheme_hash_tree_set(red_props, prop, proc);
has_redirect = 1;
} else {
if (!empty_red_props)
empty_red_props = scheme_make_hash_tree(0);
empty_red_props = scheme_hash_tree_set(empty_red_props, prop, proc);
}
} else if (st) {
if (SCHEME_TRUEP(proc))
if (SCHEME_TRUEP(proc)) {
SCHEME_VEC_ELS(redirects)[PRE_REDIRECTS + offset + field_pos] = proc;
else {
if (!empty_redirects)
has_redirect = 1;
} else {
if (!empty_redirects) {
empty_redirects = MALLOC_N_ATOMIC(int, 2 * stype->num_slots);
memset(empty_redirects, 0, sizeof(int) * 2 * stype->num_slots);
}
empty_redirects[offset + field_pos] = 1;
}
} else {
if (SCHEME_TRUEP(proc))
if (SCHEME_TRUEP(proc)) {
si_chaperone = proc;
else
has_redirect = 1;
} else
empty_si_chaperone = 1;
}
}
@ -6038,6 +6043,9 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
getter_positions = SCHEME_CDR(getter_positions);
}
}
if (!has_redirect && !props)
return argv[0];
if (!redirects) {
/* a non-structure chaperone */