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

[Erik Huelsmann]

Author: ehuelsmann
Date: Wed Nov 25 17:33:59 2009
New Revision: 12282

Log:
Fix PRINT-LEVEL.* tests all of which were related to
  *PRINT-LEVEL* restriction on structure printing.

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

Modified: trunk/abcl/src/org/armedbear/lisp/print.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/print.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/print.lisp	Wed Nov 25 17:33:59 2009
@@ -133,7 +133,13 @@
               (not (bit-vector-p object)))
          (output-vector object stream))
         ((structure-object-p object)
-         (print-object object stream))
+         (cond
+           ((and (null *print-readably*)
+                 *print-level*
+                 (>= *current-print-level* *print-level*))
+            (write-char #\# stream))
+           (t
+            (print-object object stream))))
         ((standard-object-p object)
          (print-object object stream))
         ((xp::xp-structure-p stream)