places: repair detection of mutable prefabs

This commit is contained in:
Matthew Flatt 2018-10-04 15:37:06 -06:00
parent c2b5e4404a
commit daba4f518b
2 changed files with 9 additions and 11 deletions

View File

@ -361,6 +361,10 @@
(try-graph "#0=#s(thing 7 #0#)"))
(check-exn exn:fail? (λ () (place-channel-put pl (open-output-string))))
(check-exn exn:fail? (λ ()
(struct s ([x #:mutable]) #:prefab)
(struct t s (y) #:prefab)
(place-channel-put pl (t 1 2))))
(check-not-exn (λ () (place-channel-put pl "Test String")))
(check-not-exn (λ () (place-channel-put pl (bytes->path #"/tmp/unix" 'unix))))
(check-not-exn (λ () (place-channel-put pl (bytes->path #"C:\\Windows" 'windows))))

View File

@ -1494,8 +1494,6 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
Scheme_Structure *st;
Scheme_Serialized_Structure *sst;
Scheme_Struct_Type *stype;
Scheme_Struct_Type *ptype;
int local_slots;
#define DEEP_DO_CDR 1
#define DEEP_DO_FIN_PAIR 2
@ -1666,9 +1664,7 @@ DEEP_VEC2:
case scheme_structure_type:
st = (Scheme_Structure*)so;
stype = st->stype;
ptype = stype->parent_types[stype->name_pos - 1];
size = stype->num_slots;
local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
if (!stype->prefab_key) {
bad_place_message2(so, fd_accumulators, can_raise_exn);
@ -1676,13 +1672,11 @@ DEEP_VEC2:
new_so = NULL;
ABORT;
}
for (i = 0; i < local_slots; i++) {
if (!stype->immutables || stype->immutables[i] != 1) {
bad_place_message2(so, fd_accumulators, can_raise_exn);
if (invalid_object) *invalid_object = so;
new_so = NULL;
ABORT;
}
if (!(MZ_OPT_HASH_KEY(&stype->iso) & STRUCT_TYPE_ALL_IMMUTABLE)) {
bad_place_message2(so, fd_accumulators, can_raise_exn);
if (invalid_object) *invalid_object = so;
new_so = NULL;
ABORT;
}
IFS_PUSH((Scheme_Object *)st);