0.7.10.11:

	A couple of array fixes
	... make DESCRIBE work on rank-0 arrays (Lutz Euler sbcl-devel
		2002-12-03)
	... make DEFTRANSFORM MAKE-ARRAY warn (or style-warn) in the
		various appropriate cases:
	* default :INITIAL-ELEMENT not compatible with :ELEMENT-TYPE
	* provided :INITIAL-ELEMENT not compatible with :ELEMENT-TYPE
	* provided :INITIAL-ELEMENT not compatible with
		(UPGRADED-ARRAY-ELEMENT-TYPE ELEMENT-TYPE)

diff --git a/NEWS b/NEWS
index 27cbbca..e67a79c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1438,6 +1438,8 @@ changes in sbcl-0.7.11 relative to sbcl-0.7.10:
     Valtteri Vuorikoski)
   * the compiler is now able to inline functions that were defined in
     a complex lexical environment (e.g. inside a MACROLET).
+  * fixed bug in DESCRIBE, which now works on rank-0 arrays.  (thanks
+    to Lutz Euler)
   * fixed some more bugs revealed by Paul Dietz' test suite:
     ** As required by ANSI, LOOP now disallows anonymous collection
        clauses such as COLLECT I in conjunction with aggregate boolean

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index 584e709..b89842f 100644 (file)
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -43,18 +43,18 @@
 
 (defmethod describe-object ((x array) s)
   (let ((rank (array-rank x)))
-    (cond ((> rank 1)
-          (format s "~S ~_is " x)
-          (write-string (if (%array-displaced-p x) "a displaced" "an") s)
-          (format s " array of rank ~S." rank)
-          (format s "~@:_Its dimensions are ~S." (array-dimensions x)))
-         (t
+    (cond ((= rank 1)
           (format s
                   "~@:_~S is a ~:[~;displaced ~]vector of length ~S." x
                   (and (array-header-p x) (%array-displaced-p x)) (length x))
           (when (array-has-fill-pointer-p x)
             (format s "~@:_It has a fill pointer, currently ~S."
-                    (fill-pointer x))))))
+                    (fill-pointer x))))
+         (t
+          (format s "~S ~_is " x)
+          (write-string (if (%array-displaced-p x) "a displaced" "an") s)
+          (format s " array of rank ~S." rank)
+          (format s "~@:_Its dimensions are ~S." (array-dimensions x)))))
   (let ((array-element-type (array-element-type x)))
     (unless (eq array-element-type t)
       (format s

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 579064e..56641ac 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -278,37 +278,41 @@
         (saetp (find-if (lambda (saetp)
                           (csubtypep eltype-type (saetp-ctype saetp)))
                         *specialized-array-element-type-properties*))
-        (creation-form `(make-array dims :element-type ',eltype
-                                    ,@(when fill-pointer
-                                        '(:fill-pointer fill-pointer))
-                                    ,@(when adjustable
-                                        '(:adjustable adjustable)))))
+        (creation-form `(make-array dims
+                         :element-type ',(type-specifier (saetp-ctype saetp))
+                         ,@(when fill-pointer
+                                 '(:fill-pointer fill-pointer))
+                         ,@(when adjustable
+                                 '(:adjustable adjustable)))))
 
     (unless saetp
       (give-up-ir1-transform "ELEMENT-TYPE not found in *SAETP*: ~S" eltype))
 
-    (cond ((or (null initial-element)
-              (and (constant-continuation-p initial-element)
-                   (eql (continuation-value initial-element)
-                        (saetp-initial-element-default saetp))))
-          (unless (csubtypep (ctype-of (saetp-initial-element-default saetp))
-                             eltype-type)
-            ;; This situation arises e.g. in (MAKE-ARRAY 4
-            ;; :ELEMENT-TYPE '(INTEGER 1 5)) ANSI's definition of
-            ;; MAKE-ARRAY says "If INITIAL-ELEMENT is not supplied,
-            ;; the consequences of later reading an uninitialized
-            ;; element of new-array are undefined," so this could be
-            ;; legal code as long as the user plans to write before
-            ;; he reads, and if he doesn't we're free to do anything
-            ;; we like. But in case the user doesn't know to write
-            ;; elements before he reads elements (or to read manuals
-            ;; before he writes code:-), we'll signal a STYLE-WARNING
-            ;; in case he didn't realize this.
-            (compiler-style-warn "The default initial element ~S is not a ~S."
-                                 (saetp-initial-element-default saetp)
-                                 eltype))
+    (cond ((and (constant-continuation-p initial-element)
+               (eql (continuation-value initial-element)
+                    (saetp-initial-element-default saetp)))
           creation-form)
          (t
+          ;; error checking for target, disabled on the host because
+          ;; (CTYPE-OF #\Null) is not possible.
+          #-sb-xc-host
+          (when (constant-continuation-p initial-element)
+            (let ((value (continuation-value initial-element)))
+              (cond
+                ((not (csubtypep (ctype-of value)
+                                 (saetp-ctype saetp)))
+                 ;; this case will cause an error at runtime, so we'd
+                 ;; better WARN about it now.
+                 (compiler-warn "~@<~S is not a ~S (which is the ~
+                                 UPGRADED-ARRAY-ELEMENT-TYPE of ~S).~@:>"
+                                value
+                                (type-specifier (saetp-ctype saetp))
+                                eltype))
+                ((not (csubtypep (ctype-of value) eltype-type))
+                 ;; this case will not cause an error at runtime, but
+                 ;; it's still worth STYLE-WARNing about.
+                 (compiler-style-warn "~S is not a ~S."
+                                      value eltype)))))
           `(let ((array ,creation-form))
             (multiple-value-bind (vector)
                 (%data-vector-and-index array 0)
@@ -339,7 +343,22 @@
     (unless saetp
       (give-up-ir1-transform
        "cannot open-code creation of ~S" result-type-spec))
-
+    #-sb-xc-host
+    (unless (csubtypep (ctype-of (saetp-initial-element-default saetp))
+                      eltype-type)
+      ;; This situation arises e.g. in (MAKE-ARRAY 4 :ELEMENT-TYPE
+      ;; '(INTEGER 1 5)) ANSI's definition of MAKE-ARRAY says "If
+      ;; INITIAL-ELEMENT is not supplied, the consequences of later
+      ;; reading an uninitialized element of new-array are undefined,"
+      ;; so this could be legal code as long as the user plans to
+      ;; write before he reads, and if he doesn't we're free to do
+      ;; anything we like. But in case the user doesn't know to write
+      ;; elements before he reads elements (or to read manuals before
+      ;; he writes code:-), we'll signal a STYLE-WARNING in case he
+      ;; didn't realize this.
+      (compiler-style-warn "The default initial element ~S is not a ~S."
+                          (saetp-initial-element-default saetp)
+                          eltype))
     (let* ((n-bits-per-element (saetp-n-bits saetp))
           (typecode (saetp-typecode saetp))
           (n-pad-elements (saetp-n-pad-elements saetp))

diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index b3f8949..8ae4a04 100644 (file)
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -27,3 +27,9 @@
 (assert (< 0
           (length (apropos-list "PRINT" :cl))
           (length (apropos-list "PRINT"))))
+\f
+;;; DESCRIBE shouldn't fail on rank-0 arrays (bug reported and fixed
+;;; by Lutz Euler sbcl-devel 2002-12-03)
+(describe #0a0)
+(describe #(1 2 3))
+(describe #2a((1 2) (3 4)))

diff --git a/version.lisp-expr b/version.lisp-expr
index ea842f6..7bff48d 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.10.10"
+"0.7.10.11"