From 3f96e22a90dd6f6d64c86fa77882f2269cbe5ffe Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 1 Nov 2016 05:40:18 -0700
Subject: Circ print: fix recursion from print methods.

Two issues addressed here, both occurring when *print-circle*
is enabled and an object has struct components which have a
custom print method that re-enters the object printer.

One issue is that the children of these components which occur
just once print with spurious labels: like #3=, when no
matching #3# occurs.  The other bug is a wrong "unexpected
duplicate object" exception caused by mismanagement of the
child object's label hash table and its merging with the parent.

* stream.h (struct stream_ctx): New member, obj_hash_prev.
Makes the parent hash table known to populate_obj_hash,
if there is a table, otherwise nil.

* lib.c (populate_obj_hash): If there is a parent table, check
each object in it. If it occurs, then bail.  I.e. don't add
objects to the child table which occur in the parent. This
fixes both issues. Also, we do the unexpected duplicate object
check right here now: if we traverse an object that already
printed without a label (because it is not known to be
duplicate), that means that a custom print method is
inappropriately introducing new references to existing
objects, contrary to the rules.  (obj_hash_merge): The logic
here is now simplified.  All entries in the child table are
simply moved to the parent. If anything already exists, that
is an unexpected stuation indicating an internal problem,
turned into a variant of the unexpected duplicate object
message.

* tests/012/circ.tl: New file, giving tests for the bugs.

* tests/012/circ.expected: New file.
---
 lib.c                   | 35 +++++++++++++++++++++++------------
 stream.h                |  1 +
 tests/012/circ.expected |  2 ++
 tests/012/circ.tl       | 14 ++++++++++++++
 4 files changed, 40 insertions(+), 12 deletions(-)
 create mode 100644 tests/012/circ.expected
 create mode 100644 tests/012/circ.tl

diff --git a/lib.c b/lib.c
index 7b67c4d1..b45547b3 100644
--- a/lib.c
+++ b/lib.c
@@ -9521,12 +9521,23 @@ static void populate_obj_hash(val obj, struct strm_ctx *ctx)
 {
 tail:
   if (circle_print_eligible(obj)) {
-    val new_p;
-    val cell = gethash_c(ctx->obj_hash, obj, mkcloc(new_p));
+    if (ctx->obj_hash_prev) {
+      val prev_cell;
+      val label = gethash_f(ctx->obj_hash_prev, obj, mkcloc(prev_cell));
+
+      if (label == colon_k)
+        uw_throwf(error_s, lit("print: unexpected duplicate object "
+                               "(misbehaving print method?)"), nao);
+      if (prev_cell)
+        return;
+    } else {
+      val new_p;
+      val cell = gethash_c(ctx->obj_hash, obj, mkcloc(new_p));
 
-    if (!new_p) {
-      rplacd(cell, t);
-      return;
+      if (!new_p) {
+        rplacd(cell, t);
+        return;
+      }
     }
   } else {
     return;
@@ -9592,11 +9603,9 @@ static void obj_hash_merge(val parent_hash, val child_hash)
     val pcell = gethash_c(parent_hash, car(cell), mkcloc(new_p));
     if (new_p)
       rplacd(pcell, cdr(cell));
-    else if (cdr(pcell) == colon_k)
+    else
       uw_throwf(error_s, lit("print: unexpected duplicate object "
-                             "(misbehaving print method?)"), nao);
-    else if (!cdr(pcell))
-      rplacd(pcell, t);
+                             "(internal error?)"), nao);
   }
 }
 
@@ -9615,15 +9624,17 @@ val obj_print(val obj, val out, val pretty)
   uw_simple_catch_begin;
 
   if (ctx) {
-    val prev_hash = ctx->obj_hash;
+    ctx->obj_hash_prev = ctx->obj_hash;
     ctx->obj_hash = make_hash(nil, nil, nil);
     populate_obj_hash(obj, ctx);
-    obj_hash_merge(prev_hash, ctx->obj_hash);
-    ctx->obj_hash = prev_hash;
+    obj_hash_merge(ctx->obj_hash_prev, ctx->obj_hash);
+    ctx->obj_hash = ctx->obj_hash_prev;
+    ctx->obj_hash_prev = nil;
   } else {
     if (cdr(lookup_var(nil, print_circle_s))) {
       ctx = &ctx_struct;
       ctx->obj_hash = make_hash(nil, nil, nil);
+      ctx->obj_hash_prev = nil;
       ctx->counter = zero;
       get_set_ctx(out, ctx);
       populate_obj_hash(obj, ctx);
diff --git a/stream.h b/stream.h
index 818ad9cd..0cc7810a 100644
--- a/stream.h
+++ b/stream.h
@@ -39,6 +39,7 @@ enum indent_mode {
 
 struct strm_ctx {
   val obj_hash;
+  val obj_hash_prev;
   val counter;
 };
 
diff --git a/tests/012/circ.expected b/tests/012/circ.expected
new file mode 100644
index 00000000..4927381e
--- /dev/null
+++ b/tests/012/circ.expected
@@ -0,0 +1,2 @@
+[["a"]]
+(#1=("a") [[#1#]])
diff --git a/tests/012/circ.tl b/tests/012/circ.tl
new file mode 100644
index 00000000..4b6e9990
--- /dev/null
+++ b/tests/012/circ.tl
@@ -0,0 +1,14 @@
+(defstruct circ-print nil
+  a
+  (:method print (me stream pretty-p)
+    (put-string "[[" stream)
+    (print me.a stream pretty-p)
+    (put-string "]]" stream)))
+
+(defvar x (let* ((l (list "a"))
+                 (c (new circ-print a l)))
+            (list l c)))
+
+(let ((*print-circle* t))
+  (prinl (new circ-print a "a"))
+  (prinl x))
-- 
cgit v1.2.3