0.8.8.6:

	Some fixes for ADJUST-ARRAY
	... make sure we copy the element in a zero-rank array;
	... don't adjust simple arrays, even if it doesn't break
		anything (because there's probably lying to compilers
		going on).

diff --git a/NEWS b/NEWS
index c66aa88..31d5983 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2319,6 +2319,10 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8:
     assembler and linker.  (thanks to Nikodemus Siivola)
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the PPC backend.
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** ADJUST-ARRAY now copies the datum in a zero rank array if
+       required.
+    ** ADJUST-ARRAY no longer adjusts non-adjustable arrays.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 6e46a9d..ed95b97 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -573,6 +573,10 @@
   "Return T if (ADJUST-ARRAY ARRAY...) would return an array identical
    to the argument, this happens for complex arrays."
   (declare (array array))
+  ;; Note that this appears not to be a fundamental limitation.
+  ;; non-vector SIMPLE-ARRAYs are in fact capable of being adjusted,
+  ;; but in practice we test using ADJUSTABLE-ARRAY-P in ADJUST-ARRAY.
+  ;; -- CSR, 2004-03-01.
   (not (typep array 'simple-array)))
 \f
 ;;;; fill pointer frobbing stuff
@@ -770,8 +774,15 @@
                                       new-data dimensions new-length
                                       element-type initial-element
                                       initial-element-p))
-                  (set-array-header array new-data new-length
-                                    new-length 0 dimensions nil)))))))))
+                  (if (adjustable-array-p array)
+                      (set-array-header array new-data new-length
+                                        new-length 0 dimensions nil)
+                      (let ((new-array
+                             (make-array-header
+                              sb!vm:simple-array-widetag array-rank)))
+                        (set-array-header new-array new-data new-length
+                                          new-length 0 dimensions nil)))))))))))
+  
 
 (defun get-new-fill-pointer (old-array new-array-size fill-pointer)
   (cond ((not fill-pointer)
@@ -900,7 +911,7 @@
     (macrolet ((bump-index-list (index limits)
                 `(do ((subscripts ,index (cdr subscripts))
                       (limits ,limits (cdr limits)))
-                     ((null subscripts) nil)
+                     ((null subscripts) :eof)
                    (cond ((< (the fixnum (car subscripts))
                              (the fixnum (car limits)))
                           (rplaca subscripts
@@ -909,7 +920,7 @@
                          (t (rplaca subscripts 0))))))
       (do ((index (make-list (length old-dims) :initial-element 0)
                  (bump-index-list index limits)))
-         ((null index))
+         ((eq index :eof))
        (setf (aref new-data (row-major-index-from-dims index new-dims))
              (aref old-data
                    (+ (the fixnum (row-major-index-from-dims index old-dims))

diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index 3eafab5..098cd0e 100644 (file)
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -155,3 +155,7 @@
                          (setf (aref a 2) #\c)
                          a)))))
   (assert (= (length (funcall f)) 4)))
+
+(let ((x (make-array nil :initial-element 'foo)))
+  (adjust-array x nil)
+  (assert (eql (aref x) 'foo)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 1c9e321..38ac28a 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.8.5"
+"0.8.8.6"