0.7.11.6:

	Fix bugs identified by Paul Dietz (cmucl-imp 2003-01-03) for
		printing and reading arrays
	... inspired by but slightly different from Gerd Moellmann fixes
		cmucl-imp 2003-01-04

diff --git a/NEWS b/NEWS
index a37479d..80a1c63 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1494,6 +1494,9 @@ changes in sbcl-0.7.12 relative to sbcl-0.7.11:
   * fixed bug 62: constraints were not propagated into a loop.
   * fixed bug in embedded calls of SORT (reported and investigated by
     Wolfgang Jenkner).
+  * fixed bugs identified by Paul F. Dietz related to printing and
+    reading of arrays with some dimensions having length 0.  (thanks
+    to Gerd Moellmann)
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 69632eb..60c1569 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -855,6 +855,7 @@ retained, possibly temporariliy, because it might be used internally."
              "ABOUT-TO-MODIFY-SYMBOL-VALUE"
             "SYMBOL-SELF-EVALUATING-P"
              "PRINT-PRETTY-ON-STREAM-P"
+            "ARRAY-READABLY-PRINTABLE-P"
              "LOOKS-LIKE-NAME-OF-SPECIAL-VAR-P"
              "POSITIVE-PRIMEP"
              "EVAL-IN-LEXENV"

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 25fd9a0..af346a5 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -974,7 +974,8 @@
             (stringp array)
             (bit-vector-p array))
         (output-ugly-object array stream))
-       ((and *print-readably* (not (eq (array-element-type array) t)))
+       ((and *print-readably*
+             (not (array-readably-printable-p array)))
         (let ((*print-readably* nil))
           (error 'print-not-readable :object array)))
        ((vectorp array)

diff --git a/src/code/print.lisp b/src/code/print.lisp
index ac90cfe..91f200f 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -973,7 +973,7 @@
           (write-char (if (zerop bit) #\0 #\1) stream)))
        (t
         (when (and *print-readably*
-                   (not (eq (array-element-type vector) t)))
+                   (not (array-readably-printable-p array)))
           (error 'print-not-readable :object vector))
         (descend-into (stream)
                       (write-string "#(" stream)
@@ -1000,6 +1000,14 @@
          (when (needs-slash-p char) (write-char #\\ stream))
          (write-char char stream))))))
 
+(defun array-readably-printable-p (array)
+  (and (eq (array-element-type array) t)
+       (let ((zero (position 0 (array-dimensions array)))
+            (number (position 0 (array-dimensions array)
+                              :test (complement #'eql)
+                              :from-end t)))
+        (or (null zero) (null number) (> zero number)))))
+
 ;;; Output the printed representation of any array in either the #< or #A
 ;;; form.
 (defun output-array (array stream)
@@ -1016,7 +1024,7 @@
 ;;; Output the readable #A form of an array.
 (defun output-array-guts (array stream)
   (when (and *print-readably*
-            (not (eq (array-element-type array) t)))
+            (not (array-readably-printable-p array)))
     (error 'print-not-readable :object array))
   (write-char #\# stream)
   (let ((*print-base* 10))

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index 233a35a..273a6a6 100644 (file)
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -96,12 +96,13 @@
                         dimensions axis seq))
        (let ((len (length seq)))
          (dims len)
-         (unless (= axis (1- dimensions))
-           (when (zerop len)
-             (%reader-error stream
-                            "#~WA axis ~W is empty, but is not ~
-                             the last dimension."
-                            dimensions axis))
+         (unless (or (= axis (1- dimensions))
+                     ;; ANSI: "If some dimension of the array whose
+                     ;; representation is being parsed is found to be
+                     ;; 0, all dimensions to the right (i.e., the
+                     ;; higher numbered dimensions) are also
+                     ;; considered to be 0."
+                     (= len 0))
            (setq seq (elt seq 0))))))))
 \f
 ;;;; reading structure instances: the #S readmacro

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index b592d84..68420b1 100644 (file)
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -103,5 +103,24 @@
 (assert (raises-error? (format nil "~<~<~A~:>~>" '(foo))))
 (assert (string= (format nil "~<~<~A~>~>" 'foo) "FOO"))
 
+;;; Check that arrays that we print while *PRINT-READABLY* is true are
+;;; in fact generating similar objects.
+(assert (equal (array-dimensions
+               (read-from-string
+                (with-output-to-string (s)
+                  (let ((*print-readably* t))
+                    (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)))))
+
 ;;; success
 (quit :unix-status 104)

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 77ba498..7eddc5d 100644 (file)
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -74,3 +74,12 @@
   (assert (= (parse-integer "12") 12))
   (assert (= (parse-integer "   12   ") 12))
   (assert (= (parse-integer "   12asdb" :junk-allowed t) 12)))
+
+;;; #A notation enforces that once one 0 dimension has been found, all
+;;; subsequent ones are also 0.  
+(assert (equal (array-dimensions (read-from-string "#3A()"))
+              '(0 0 0)))
+(assert (equal (array-dimensions (read-from-string "#3A(())"))
+              '(1 0 0)))
+(assert (equal (array-dimensions (read-from-string "#3A((() ()))"))
+              '(1 2 0)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 033a033..fd08eaf 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.11.5"
+"0.7.11.6"