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

Merge to v5.3.1

collects/tests/racket/place-struct-info.rkt

@@ -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))))

src/racket/src/error.c

@@ -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,

src/racket/src/schpriv.h

@@ -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);

src/racket/src/struct.c

@@ -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];