[armedbear-cvs] r13407 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Jul 15 14:18:28 2011
New Revision: 13407

Log:
Eliminate a series of PPRINT.* ansi test suite failures
(dropping my test failure count from 27 to 20!).

Modified:
   trunk/abcl/src/org/armedbear/lisp/pprint.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/pprint.lisp	Fri Jul 15 09:34:23 2011	(r13406)
+++ trunk/abcl/src/org/armedbear/lisp/pprint.lisp	Fri Jul 15 14:18:28 2011	(r13407)
@@ -611,12 +611,14 @@
   (if (xp-structure-p stream)
       (apply fn stream args)
       (let ((*abbreviation-happened* nil)
-	    (sys::*circularity-hash-table*
-             (if (and *print-circle* (null sys::*circularity-hash-table*))
-                 (make-hash-table :test 'eq)
-                 sys::*circularity-hash-table*))
 	    (*result* nil))
-	(xp-print fn (sys:out-synonym-of stream) args)
+        (if (and *print-circle* (null sys::*circularity-hash-table*))
+            (let ((sys::*circularity-hash-table* (make-hash-table :test 'eq)))
+              (xp-print fn (make-broadcast-stream) args)
+              (let ((sys::*circularity-counter* 0))
+                (xp-print fn (sys:out-synonym-of stream) args)
+                ))
+            (xp-print fn (sys:out-synonym-of stream) args))
 	*result*)))
 
 (defun xp-print (fn stream args)