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

fix problem with places and `struct-type-info'

Browse Source 
Merge to v5.3.1
This commit is contained in:
Matthew Flatt 2012-11-01 07:19:19 -06:00
parent e7dc4a70ee
commit 0e4305fc45
4 changed files with 39 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/tests/racket/place-struct-info.rkt Normal file
View File

@ -0,0 +1,20 @@
#lang racket/base
(require racket/place)
;; Some results from `struct-type-info' may be created on demand.
;; Check that any sharing of `struct:exn' across places handles
;; that on-demand creation correctly.
(define (go)
(place
pch
(define-values (sym init auto ref set! imms par skip?)
(struct-type-info struct:exn))
(unless (procedure? ref)
(error "bad reference procedure"))
(collect-garbage)))
(module+ main
(void (place-wait (go)))
(collect-garbage)
(void (place-wait (go))))

1
src/racket/src/error.c
View File

@ -4313,6 +4313,7 @@ void scheme_init_exn(Scheme_Env *env)
if (exn_table[i].count) {
Scheme_Object **values;
scheme_force_struct_type_info((Scheme_Struct_Type *)exn_table[i].type);
values = scheme_make_struct_values(exn_table[i].type,
exn_table[i].names,
exn_table[i].count,

2
src/racket/src/schpriv.h
View File

@ -850,6 +850,8 @@ Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *s, int num_
Scheme_Object *scheme_struct_getter(int argc, Scheme_Object **args, Scheme_Object *prim);
Scheme_Object *scheme_struct_setter(int argc, Scheme_Object **args, Scheme_Object *prim);
void scheme_force_struct_type_info(Scheme_Struct_Type *stype);
Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);
Scheme_Object *scheme_rename_struct_proc(Scheme_Object *p, Scheme_Object *sym);

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

@ -2643,18 +2643,8 @@ static Scheme_Object *check_type_and_inspector(const char *who, int always, int
return insp;
}
static void get_struct_type_info(int argc, Scheme_Object *argv[], Scheme_Object **a, int always)
void scheme_force_struct_type_info(Scheme_Struct_Type *stype)
{
Scheme_Struct_Type *stype, *parent;
Scheme_Object *insp, *ims;
int p, cnt;
insp = check_type_and_inspector("struct-type-info", always, argc, argv);
if (SCHEME_NP_CHAPERONEP(argv[0]))
stype = (Scheme_Struct_Type *)SCHEME_CHAPERONE_VAL(argv[0]);
else
stype = (Scheme_Struct_Type *)argv[0];
/* Make sure generic accessor and mutator are created: */
if (!stype->accessor) {
Scheme_Object *p;
@ -2667,6 +2657,21 @@ static void get_struct_type_info(int argc, Scheme_Object *argv[], Scheme_Object
p = make_struct_proc(stype, fn, SCHEME_GEN_SETTER, 0);
stype->mutator = p;
}
}
static void get_struct_type_info(int argc, Scheme_Object *argv[], Scheme_Object **a, int always)
{
Scheme_Struct_Type *stype, *parent;
Scheme_Object *insp, *ims;
int p, cnt;
insp = check_type_and_inspector("struct-type-info", always, argc, argv);
if (SCHEME_NP_CHAPERONEP(argv[0]))
stype = (Scheme_Struct_Type *)SCHEME_CHAPERONE_VAL(argv[0]);
else
stype = (Scheme_Struct_Type *)argv[0];
scheme_force_struct_type_info(stype);
if (stype->name_pos)
parent = stype->parent_types[stype->name_pos - 1];