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

repair chaperone handling in potential place messages

Browse Source 
Closes #2630
This commit is contained in:
Matthew Flatt 2019-04-28 10:27:34 -05:00
parent e13fcd6226
commit 8f0fb72160
3 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/place.rktl
View File

@ -106,6 +106,20 @@
(test (not (place-enabled?)) place-message-allowed? (cons v 1))
(test (not (place-enabled?)) place-message-allowed? (vector v)))
(let ()
(struct s (a) #:prefab)
(struct p (x))
(define c (chaperone-struct (p 1)
p-x
(lambda (s v) v)))
(test (not (place-enabled?)) place-message-allowed? (s (lambda () 1)))
(test (not (place-enabled?)) place-message-allowed? (s c))
(test (not (place-enabled?)) place-message-allowed? (hasheq c 5))
(test (not (place-enabled?)) place-message-allowed? (hasheq 5 c))
(test (not (place-enabled?)) place-message-allowed? (vector c))
(test (not (place-enabled?)) place-message-allowed? (cons c 6))
(test (not (place-enabled?)) place-message-allowed? (cons 6 c)))
;; ----------------------------------------
;; Place messages and chaperones

7
racket/src/racket/src/list.c
View File

@ -3676,7 +3676,12 @@ Scheme_Object *scheme_chaperone_hash_table_filtered_copy(Scheme_Object *obj,
key = scheme_hash_table_iterate_key(2, a);
val = scheme_chaperone_hash_get(obj, key);
if (filter && val) val = filter(val);
if (filter && val) {
key = filter(key);
if (!key) return NULL;
val = filter(val);
if (!val) return NULL;
}
if (val) {
a[0] = v2;
a[1] = key;

10
racket/src/racket/src/place.c
View File

@ -1976,8 +1976,12 @@ static Scheme_Object *strip_chaperones(Scheme_Object *so)
o = so;
if (SCHEME_PAIRP(o)) {
return scheme_make_pair(strip_chaperones(SCHEME_CAR(o)),
strip_chaperones(SCHEME_CDR(o)));
Scheme_Object *a, *d;
a = strip_chaperones(SCHEME_CAR(o));
if (!a) return NULL;
d = strip_chaperones(SCHEME_CDR(o));
if (!d) return NULL;
return scheme_make_pair(a, d);
} else if (SCHEME_VECTORP(o)) {
Scheme_Object *v, *e;
intptr_t len = SCHEME_VEC_SIZE(o), i;
@ -1988,6 +1992,7 @@ static Scheme_Object *strip_chaperones(Scheme_Object *so)
else
e = scheme_chaperone_vector_ref(so, i);
e = strip_chaperones(e);
if (!e) return NULL;
SCHEME_VEC_ELS(v)[i] = e;
}
return v;
@ -2006,6 +2011,7 @@ static Scheme_Object *strip_chaperones(Scheme_Object *so)
else
e = scheme_struct_ref(so, i);
e = strip_chaperones(e);
if (!e) return NULL;
s2->slots[i] = e;
}
return (Scheme_Object *)s2;