From 3163b23894a874af169a12b701f6e7a4a32ff80b Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Tue, 30 Jun 1998 10:58:55 +0000 Subject: [PATCH] Fix for attempts to print specialized arrays readably. From Ray Toy. --- code/pprint.lisp | 4 ++-- code/print.lisp | 9 +++++---- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/code/pprint.lisp b/code/pprint.lisp index 47afb1200..c26d4fcfd 100644 --- a/code/pprint.lisp +++ b/code/pprint.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.24 1998/05/04 01:27:14 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.25 1998/06/30 10:58:55 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1120,7 +1120,7 @@ (output-ugly-object array stream)) ((and *print-readably* (not (eq (array-element-type array) 't))) (let ((*print-readably* nil)) - (error "~S cannot be printed readably."))) + (error 'print-not-readable :object array))) ((vectorp array) (pprint-vector stream array)) (t diff --git a/code/print.lisp b/code/print.lisp index b044291fd..843d7869b 100644 --- a/code/print.lisp +++ b/code/print.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.72 1998/05/05 00:14:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.73 1998/06/30 10:58:54 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -248,8 +248,9 @@ ((object :reader print-not-readable-object :initarg :object)) (:report (lambda (condition stream) - (format stream "~S cannot be printed readably." - (print-not-readable-object condition))))) + (let ((obj (print-not-readable-object condition)) + (*print-array* nil)) + (format stream "~S cannot be printed readably." obj))))) (defun %print-unreadable-object (object stream type identity body) (when *print-readably* @@ -1065,7 +1066,7 @@ (defun output-array-guts (array stream) (when (and *print-readably* (not (eq (array-element-type array) t))) - (error 'print-not-readable :object (array-element-type array))) + (error 'print-not-readable :object array)) (write-char #\# stream) (let ((*print-base* 10)) (output-integer (array-rank array) stream)) -- GitLab