reject prefab specs with bad mutability indices

Closes PR 14887
This commit is contained in:
Matthew Flatt 2014-12-19 20:12:06 -07:00
parent 9419bf42a1
commit 31ebe213cc
2 changed files with 12 additions and 1 deletions

View File

@ -1112,6 +1112,13 @@
(err/rt-test (make-prefab-struct '(foo 2999999999999999) 1))
(err/rt-test (make-prefab-struct '(foo 5 bar 2999999999999999) 1))
;; ----------------------------------------
;; Check that prefab mutable-field spec makes sense for size:
(err/rt-test (make-prefab-struct '(foo 5 (1 #f) #(1) bar 2 #(99999)) 1 2 3 4 5 6 7 8))
(test #t struct? (make-prefab-struct '(foo 5 (1 #f) #(1) bar 2 #()) 1 2 3 4 5 6 7 8))
(test #t struct? (make-prefab-struct '(foo 5 (1 #f) #(1) bar 0 #()) 1 2 3 4 5 6))
;; ----------------------------------------
(report-errs)

View File

@ -5446,7 +5446,11 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
return NULL;
name = a;
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables);
if ((icnt + ucnt) || (mutables && SCHEME_VEC_SIZE(mutables))) {
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables);
if (!immutable_array)
return NULL;
}
if (parent && (icnt + parent->num_slots > MAX_STRUCT_FIELD_COUNT))
return NULL;