Merge pull request #1407 from clasp-developers/unreadable

Cleanup some print-unreadable-object uses

Author: yitzchak

RELEASE_NOTES.md

@@ -1,3 +1,8 @@
+# Version 2.2.0 (LLVM14) Pending
+
+## Fixes
+* Ensure that `print-unreadable-object` can accept output stream designators.
+
 # Version 2.1.0 (LLVM14) 2023-01-01
 
 ## Added

src/core/lispStream.cc

@@ -5071,12 +5071,12 @@ void writeln_bf_stream(const std::string& fmt, T_sp strm)
 
 CL_LAMBDA(oject stream);
 CL_DECLARE();
-CL_DOCSTRING("Write the address of an object to the stream.");
+CL_DOCSTRING("Write the address of an object to the stream designator.");
 DOCGROUP(clasp);
 CL_DEFUN void core__write_addr(T_sp x, T_sp strm) {
   stringstream ss;
   ss << (void *)x.raw_();
-  writestr_stream(ss.str().c_str(), strm);
+  writestr_stream(ss.str().c_str(), coerce::outputStreamDesignator(strm));
 }
 
 static cl_index

src/lisp/kernel/clos/print.lisp

@@ -201,15 +201,13 @@ printer and we should rather use MAKE-LOAD-FORM."
   instance)
 
 (defmethod print-object ((class class) stream)
-  (print-unreadable-object (class stream)
-    (let ((*package* (find-package "CL")))
-      (format stream "The ~S ~S"
-	      (class-name (si:instance-class class)) (class-name class))))
+  (print-unreadable-object (class stream :type t)
+    (write (class-name class) :stream stream))
   class)
 
 (defmethod print-object ((gf standard-generic-function) stream)
   (print-unreadable-object (gf stream :type t)
-    (prin1 (generic-function-name gf) stream))
+    (write (generic-function-name gf) :stream stream))
   gf)
 
 (defmethod print-object ((m standard-method) stream)

src/lisp/kernel/lsp/iolib.lisp

@@ -323,9 +323,15 @@ the one defined in the ANSI standard. *print-base* is 10, *print-array* is t,
   (cond (*print-readably*
          (error 'print-not-readable :object object))
         (t
-         (write-string "#<" stream)
-         (print-unreadable-object-contents object stream type identity body)
-         (write-char #\> stream)))
+         (let ((stream (cond ((null stream)
+                              *standard-output*)
+                             ((eq t stream)
+                              *terminal-io*)
+                             (t
+                              stream))))
+           (write-string "#<" stream)
+           (print-unreadable-object-contents object stream type identity body)
+           (write-char #\> stream))))
   nil)
 
 (defmacro print-unreadable-object ((object stream &key type identity) &body body)

src/lisp/kernel/lsp/pprint.lisp

@@ -1224,7 +1224,13 @@
          (pprint-logical-block (stream nil :prefix "#<" :suffix ">")
            (print-unreadable-object-contents object stream type identity body)))
         (t
-         (write-string "#<" stream)
-         (print-unreadable-object-contents object stream type identity body)
-         (write-char #\> stream)))
+         (let ((stream (cond ((null stream)
+                              *standard-output*)
+                             ((eq t stream)
+                              *terminal-io*)
+                             (t
+                              stream))))
+           (write-string "#<" stream)
+           (print-unreadable-object-contents object stream type identity body)
+           (write-char #\> stream))))
   nil)