fix problem with prefabs, auto fields, and construction via a key
Auto fields were incorrectly recorded as immutable in a structure type that is first generated from the prefab struct key instead of `make-struct-type`. Thanks to Deren Dohoda for the report.
This commit is contained in:
parent
31d82eb9a6
commit
f8c7feaf88
|
@ -1198,6 +1198,24 @@
|
|||
#:authentic)
|
||||
'ok)))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check that constructing a prefab type via its key before via
|
||||
;; `make-struct-type` gets the mutability of auto fields right.
|
||||
|
||||
(let ([s (string->symbol (format "s~a" (current-milliseconds)))])
|
||||
(define v (read (open-input-string (format "#s((~a (2 #f)) 1 2)" s))))
|
||||
(define-values (struct: make- ? -ref -set!)
|
||||
(make-struct-type s #f 0 2 #f null 'prefab))
|
||||
(-set! v 0 'ok)
|
||||
(test 'ok -ref v 0))
|
||||
|
||||
(let ([s (string->symbol (format "s~a" (current-milliseconds)))])
|
||||
(define v (read (open-input-string (format "#s((~a (2 #f)) 'x 'y 'z 1 2)" s))))
|
||||
(define-values (struct: make- ? -ref -set!)
|
||||
(make-struct-type s #f 3 2 #f null 'prefab #f '(0 1 2)))
|
||||
(-set! v 3 'ok)
|
||||
(test 'ok -ref v 3))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
@ -5613,19 +5613,20 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type)
|
|||
return key;
|
||||
}
|
||||
|
||||
static char *mutability_data_to_immutability_data(int icnt, Scheme_Object *mutables, int *_min_cnt)
|
||||
static char *mutability_data_to_immutability_data(int icnt, int ucnt, Scheme_Object *mutables, int *_min_cnt)
|
||||
/* If `_min_cnt` is not NULL, then mutability positions can determine a minimum
|
||||
argument count that is bigger than `icnt`. */
|
||||
{
|
||||
char *immutable_array = NULL, *a2;
|
||||
|
||||
if (_min_cnt)
|
||||
*_min_cnt = icnt;
|
||||
*_min_cnt = icnt + ucnt;
|
||||
|
||||
if ((icnt > 0) || _min_cnt) {
|
||||
int sz = (icnt ? icnt : 1);
|
||||
immutable_array = (char *)scheme_malloc_atomic(icnt);
|
||||
int sz = icnt + ucnt + 1;
|
||||
immutable_array = (char *)scheme_malloc_atomic(icnt + ucnt);
|
||||
memset(immutable_array, 1, icnt);
|
||||
memset(immutable_array XFORM_OK_PLUS icnt, 0, ucnt);
|
||||
|
||||
if (mutables) {
|
||||
int i;
|
||||
|
@ -5644,8 +5645,8 @@ static char *mutability_data_to_immutability_data(int icnt, Scheme_Object *mutab
|
|||
&& !_min_cnt))
|
||||
return NULL;
|
||||
a_val = SCHEME_INT_VAL(a);
|
||||
if (_min_cnt && (a_val >= *_min_cnt)) {
|
||||
*_min_cnt = a_val+1;
|
||||
if (_min_cnt && ((a_val+ucnt) >= *_min_cnt)) {
|
||||
*_min_cnt = a_val+ucnt+1;
|
||||
}
|
||||
if (a_val >= sz) {
|
||||
a2 = (char *)scheme_malloc_atomic(a_val * 2);
|
||||
|
@ -5749,9 +5750,10 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int min_field_
|
|||
return NULL;
|
||||
name = a;
|
||||
|
||||
if ((icnt + ucnt) || (mutables && SCHEME_VEC_SIZE(mutables))) {
|
||||
if (icnt || (mutables && SCHEME_VEC_SIZE(mutables))) {
|
||||
int min_cnt;
|
||||
immutable_array = mutability_data_to_immutability_data(icnt + ucnt,
|
||||
immutable_array = mutability_data_to_immutability_data(icnt,
|
||||
ucnt,
|
||||
mutables,
|
||||
inferred_size ? &min_cnt : NULL);
|
||||
if (!immutable_array)
|
||||
|
|
Loading…
Reference in New Issue
Block a user