From bd0e6ae941fde7193f8cf5098537e669057fddd5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 5 Nov 2012 10:48:19 -0700
Subject: [PATCH] fix problems with chaperones, printing, and cycles

---
 collects/tests/racket/chaperone.rktl | 15 +++++++++++++++
 src/racket/src/print.c               | 26 +++++++++++++++++++-------
 2 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/collects/tests/racket/chaperone.rktl b/collects/tests/racket/chaperone.rktl
index 00d5649315..8c13773e6b 100644
--- a/collects/tests/racket/chaperone.rktl
+++ b/collects/tests/racket/chaperone.rktl
@@ -1299,6 +1299,21 @@
    (test #f values set-proc)
    (test #f values remove-proc)))
 
+;; ----------------------------------------
+;; Check interaciton of chaperones and cycle checks
+
+(let ()
+  (struct a ([x #:mutable]) #:transparent)
+
+  (define an-a (a #f))
+  (set-a-x! an-a an-a)
+  (let ([o (open-output-bytes)])
+    (print
+     (chaperone-struct an-a
+                       a-x (lambda (s v) v))
+     o)
+    (test #"(a #0=(a #0#))" get-output-bytes o)))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/src/racket/src/print.c b/src/racket/src/print.c
index 6a4af29571..d6410bb4d1 100644
--- a/src/racket/src/print.c
+++ b/src/racket/src/print.c
@@ -510,8 +510,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
       || SCHEME_MUTABLE_PAIRP(obj)
       || (pp->print_box && SCHEME_CHAPERONE_BOXP(obj))
       || SCHEME_CHAPERONE_VECTORP(obj)
-      || ((SAME_TYPE(t, scheme_structure_type)
-	   || SAME_TYPE(t, scheme_proc_struct_type))
+      || (SCHEME_CHAPERONE_STRUCTP(obj)
           && ((pp->print_struct 
 	       && PRINTABLE_STRUCT(obj, pp))
 	      || scheme_is_writable_struct(obj)))
@@ -566,8 +565,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
       if ((for_write < 3) && res)
 	return res;
     }
-  } else if (SAME_TYPE(t, scheme_structure_type)
-	     || SAME_TYPE(t, scheme_proc_struct_type)) {
+  } else if (SCHEME_CHAPERONE_STRUCTP(obj)) {
     if (scheme_is_writable_struct(obj)) {
       if (pp->print_unreadable) {
         res = check_cycles(writable_struct_subs(obj, for_write, pp), for_write, ht, pp);
@@ -589,7 +587,12 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
         res = 0;
     } else {
       /* got here => printable */
-      int i = SCHEME_STRUCT_NUM_SLOTS(obj);
+      int i;
+
+      if (SCHEME_CHAPERONEP(obj))
+        i = SCHEME_STRUCT_NUM_SLOTS(SCHEME_CHAPERONE_VAL(obj));
+      else
+        i = SCHEME_STRUCT_NUM_SLOTS(obj);
 
       if ((for_write >= 3) && !SCHEME_PREFABP(obj))
         res = 0x1;
@@ -597,7 +600,11 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
         res = 0;
       while (i--) {
 	if (scheme_inspector_sees_part(obj, pp->inspector, i)) {
-	  res2 = check_cycles(((Scheme_Structure *)obj)->slots[i], for_write, ht, pp);
+          if (SCHEME_CHAPERONEP(obj))
+            val = scheme_struct_ref(obj, i);
+          else
+            val = ((Scheme_Structure *)obj)->slots[i];
+	  res2 = check_cycles(val, for_write, ht, pp);
           res |= res2;
           if ((for_write < 3) && res)
             return res;
@@ -867,7 +874,12 @@ static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Tab
 	setup_graph_table(obj, for_write, ht, counter, pp);
       }
     } else {
-      int i = SCHEME_STRUCT_NUM_SLOTS(obj);
+      int i;
+
+      if (SCHEME_CHAPERONEP(obj))
+        i = SCHEME_STRUCT_NUM_SLOTS(SCHEME_CHAPERONE_VAL(obj));
+      else
+        i = SCHEME_STRUCT_NUM_SLOTS(obj);
 
       while (i--) {
 	if (scheme_inspector_sees_part(obj, pp->inspector, i))