From: Christophe Rhodes Date: Wed, 8 Jan 2003 10:59:10 +0000 (+0000) Subject: 0.7.11.6: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=80cee3cf18d09202aa30ab957e08c5759e573bbe;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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)))))))) ;;;; reading structure instances: the #S readmacro diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index b592d84..68420b1 100644 --- 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 --- 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 --- 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"