From dc8d2fb7fcf482748253f547ffb069b7aa3860c1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 10 Jan 2014 06:53:19 -0600
Subject: [PATCH] fix memory problem with places & built-in structure types

Thanks to Asumu for tracking down the problem.
---
 .../racket-test/tests/racket/struct.rktl      | 10 ++++++++++
 racket/src/racket/src/struct.c                | 20 ++++++++++++-------
 2 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/struct.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/struct.rktl
index 641d766ce5..03a80ed0fa 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/struct.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/struct.rktl
@@ -1096,6 +1096,16 @@
     (set! f (lambda () (thing.id! (make-thing 1) 'new-val)))
     (err/rt-test (f))))
 
+;; ----------------------------------------
+;; Check interaction of `struct-type-info` and GC:
+
+(struct-type-info struct:arity-at-least)
+(collect-garbage)
+(let-values ([(name init-cnt auto-cnt acc mut immut super skipped?)
+              (struct-type-info struct:arity-at-least)])
+  (test #t procedure? acc)
+  (test #t procedure? mut))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c
index 9ddd65169b..0f3bad1c69 100644
--- a/racket/src/racket/src/struct.c
+++ b/racket/src/racket/src/struct.c
@@ -4581,7 +4581,7 @@ Scheme_Object *scheme_make_struct_type_from_string(const char *base,
 						   Scheme_Object *guard,
 						   int immutable)
 {
-  Scheme_Object *basesym;
+  Scheme_Object *basesym, *r;
   char *immutable_array = NULL;
 
   if (immutable) {
@@ -4591,12 +4591,18 @@ Scheme_Object *scheme_make_struct_type_from_string(const char *base,
 
   basesym = scheme_intern_exact_symbol(base, strlen(base));
 
-  return _make_struct_type(basesym,
-			   parent, scheme_false, 
-			   num_fields, 0, 
-			   NULL, props,
-			   NULL, immutable_array,
-			   guard);
+  r = _make_struct_type(basesym,
+                        parent, scheme_false, 
+                        num_fields, 0, 
+                        NULL, props,
+                        NULL, immutable_array,
+                        guard);
+
+  if (scheme_starting_up)
+    /* Force allocation for a strcuture type that may be in the master GC: */
+    scheme_force_struct_type_info((Scheme_Struct_Type *)r);
+
+  return r;
 }
 
 static Scheme_Struct_Type *lookup_prefab(Scheme_Object *key) {