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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Aug  6 09:59:33 2011
New Revision: 13446

Log:
Fix #158: Print "#<abc>" fails with *PRINT-READABLY* non-NIL.

Note: This commit also fixes some failures in the random testing
   ANSI tests, notably PRINT.RANDOM.SYMBOL.*.

Modified:
   trunk/abcl/src/org/armedbear/lisp/LispObject.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/print.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispObject.java	Sat Aug  6 07:46:28 2011	(r13445)
+++ trunk/abcl/src/org/armedbear/lisp/LispObject.java	Sat Aug  6 09:59:33 2011	(r13446)
@@ -781,6 +781,10 @@
    */
   public final String unreadableString(String s, boolean identity)
   {
+    if (Symbol.PRINT_READABLY.symbolValue() != NIL) {
+        error(new PrintNotReadable(list(Keyword.OBJECT, this)));
+        return null; // not reached
+    }
     StringBuilder sb = new StringBuilder("#<");
     sb.append(s);
     if (identity) {

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	Sat Aug  6 07:46:28 2011	(r13445)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Sat Aug  6 09:59:33 2011	(r13446)
@@ -908,18 +908,6 @@
             else
                 out = second;
             String output = first.printObject();
-            if (Symbol.PRINT_READABLY.symbolValue(LispThread.currentThread()) != NIL
-                && output.contains("#<")) {
-                //### Ticket #160: the cause lies here.
-                // You can't just go scan the content of the printed string,
-                // because the marker being sought may be part of the readable
-                // presentation
-                LispObject args = NIL;
-                args = args.push(first);
-                args = args.push(Keyword.OBJECT);
-                args = args.nreverse();
-                return error(new PrintNotReadable(args));
-            }
             checkStream(out)._writeString(output);
             return first;
         }

Modified: trunk/abcl/src/org/armedbear/lisp/print.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/print.lisp	Sat Aug  6 07:46:28 2011	(r13445)
+++ trunk/abcl/src/org/armedbear/lisp/print.lisp	Sat Aug  6 09:59:33 2011	(r13446)
@@ -280,10 +280,6 @@
 	   (symbol-package x))))
 
 (defun %print-object (object stream)
-  (when (and *print-readably* 
-             (typep object 'string)
-             (search "#<" object))
-    (error 'print-not-readable :object object))
   (if *print-pretty*
       (xp::output-pretty-object object stream)
       (output-ugly-object object stream)))