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

fix problem with prefabs, auto fields, and construction via a key

Browse Source 
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:
Matthew Flatt 2017-06-22 10:30:48 -06:00
parent 31d82eb9a6
commit f8c7feaf88
2 changed files with 28 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-test-core/tests/racket/struct.rktl
View File

@ -1198,6 +1198,24 @@
#:authentic) #:authentic)
'ok))) '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) (report-errs)

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

@ -5613,19 +5613,20 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type)
return key; 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 /* If `_min_cnt` is not NULL, then mutability positions can determine a minimum
argument count that is bigger than `icnt`. */ argument count that is bigger than `icnt`. */
{ {
char *immutable_array = NULL, *a2; char *immutable_array = NULL, *a2;
if (_min_cnt) if (_min_cnt)
*_min_cnt = icnt; *_min_cnt = icnt + ucnt;
if ((icnt > 0) || _min_cnt) { if ((icnt > 0) || _min_cnt) {
int sz = (icnt ? icnt : 1); int sz = icnt + ucnt + 1;
immutable_array = (char *)scheme_malloc_atomic(icnt); immutable_array = (char *)scheme_malloc_atomic(icnt + ucnt);
memset(immutable_array, 1, icnt); memset(immutable_array, 1, icnt);
memset(immutable_array XFORM_OK_PLUS icnt, 0, ucnt);
if (mutables) { if (mutables) {
int i; int i;
@ -5644,8 +5645,8 @@ static char *mutability_data_to_immutability_data(int icnt, Scheme_Object *mutab
&& !_min_cnt)) && !_min_cnt))
return NULL; return NULL;
a_val = SCHEME_INT_VAL(a); a_val = SCHEME_INT_VAL(a);
if (_min_cnt && (a_val >= *_min_cnt)) { if (_min_cnt && ((a_val+ucnt) >= *_min_cnt)) {
*_min_cnt = a_val+1; *_min_cnt = a_val+ucnt+1;
} }
if (a_val >= sz) { if (a_val >= sz) {
a2 = (char *)scheme_malloc_atomic(a_val * 2); 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; return NULL;
name = a; name = a;
if ((icnt + ucnt) || (mutables && SCHEME_VEC_SIZE(mutables))) { if (icnt || (mutables && SCHEME_VEC_SIZE(mutables))) {
int min_cnt; int min_cnt;
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, immutable_array = mutability_data_to_immutability_data(icnt,
ucnt,
mutables, mutables,
inferred_size ? &min_cnt : NULL); inferred_size ? &min_cnt : NULL);
if (!immutable_array) if (!immutable_array)