0.8.10.10:

	Fix bug in string printing and *PRINT-READABLY*.

diff --git a/NEWS b/NEWS
index ed70bfd..786c2f8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2414,6 +2414,10 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     is now consistent with (COMPLEX <x>); bugs in treatment of COMPLEX
     MEMBER and UNION types have likewise been fixed.  (thanks to Bruno
     Haible)
+  * fixed a (fairly theoretical) bug in string printing: if
+    *PRINT-READABLY* is true, signal PRINT-NOT-READABLE if the string
+    does not have array-element-type equal to the most general string
+    type.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 4981c77..bf2ece6 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -961,7 +961,13 @@
 (defun output-vector (vector stream)
   (declare (vector vector))
   (cond ((stringp vector)
-        (cond ((or *print-escape* *print-readably*)
+        (cond ((and *print-readably*
+                    (not (eq (array-element-type vector)
+                             (load-time-value
+                              (array-element-type
+                               (make-array 0 :element-type 'character))))))
+               (error 'print-not-readable :object vector))
+              ((or *print-escape* *print-readably*)
                (write-char #\" stream)
                (quote-string vector stream)
                (write-char #\" stream))

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 946c1a5..510a6b1 100644 (file)
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -112,15 +112,22 @@
                     (print (make-array '(1 2 0)) s)))))
               '(1 2 0)))
 
-(assert (multiple-value-bind (result error)
-           (ignore-errors (read-from-string
-                           (with-output-to-string (s)
-                             (let ((*print-readably* t))
-                               (print (make-array '(1 0 1)) s)))))
-         ;; it might not be readably-printable
-         (or (typep error 'print-not-readable)
-             ;; or else it had better have the same dimensions
-             (equal (array-dimensions result) '(1 0 1)))))
+(dolist (array (list (make-array '(1 0 1))
+                    (make-array 0 :element-type nil)
+                    (make-array 1 :element-type 'base-char)
+                    (make-array 1 :element-type 'character)))
+  (assert (multiple-value-bind (result error)
+             (ignore-errors (read-from-string
+                             (with-output-to-string (s)
+                               (let ((*print-readably* t))
+                                 (print array s)))))
+           ;; it might not be readably-printable
+           (or (typep error 'print-not-readable)
+               (and
+                ;; or else it had better have the same dimensions
+                (equal (array-dimensions result) (array-dimensions array))
+                ;; and the same element-type
+                (equal (array-element-type result) (array-element-type array)))))))
 
 ;;; before 0.8.0.66 it signalled UNBOUND-VARIABLE
 (write #(1 2 3) :pretty nil :readably t)

diff --git a/version.lisp-expr b/version.lisp-expr
index e201742..5853163 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.10.9"
+"0.8.10.10"