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

[Erik Huelsmann]

This commit fixes a number of test cases related to circularity detection.
Some of these cases showed loss of data. Even in the remaining failures,
there's no longer any loss of data. The cases that still fail do however
show loss of structure. That's on my list to be fixed. As it stands, I'm
very happy to finally be fixing this long standing issue in our pretty
printer.


Bye,

Erik.

On Fri, Jul 15, 2011 at 11:18 PM, <ehuelsmann at common-lisp.net> wrote:

> 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)
>
> _______________________________________________
> armedbear-cvs mailing list
> armedbear-cvs at common-lisp.net
> http://lists.common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/armedbear-devel/attachments/20110716/196ccf62/attachment.html>