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.

1 files changed, 23 insertions, 12 deletions

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