[Sbcl-commits] master: Fix adjusting non adjustable arrays.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  e15edc206310d6d8e7a4a19f2557bc1925401ad6 (commit)
      from  5be7d686b782503d16d243135b46b7093b6769f2 (commit)

- Log -----------------------------------------------------------------
commit e15edc206310d6d8e7a4a19f2557bc1925401ad6
Author: Stas Boukarev <sta...@gm...>
Date:   Sun Feb 15 17:31:45 2015 +0300

    Fix adjusting non adjustable arrays.
    
    It reused the backing vector for the new array, while it should have
    copied it.
    
    Fixes lp#886418
---
 NEWS                  |    1 +
 src/code/array.lisp   |    3 ++-
 tests/array.pure.lisp |    7 +++++++
 3 files changed, 10 insertions(+), 1 deletions(-)

diff --git a/NEWS b/NEWS
index 31fba97..c5f19b6 100644
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,7 @@ changes relative to sbcl-1.2.8:
     sb-safepoint.
   * bug fix: sb-introspect:function-lambda-list works properly on interpeted
     macros. (lp#1387404)
+  * bug fix: ADJUST-ARRAY properly handles non-adjustable arrays. (lp#886418)
 
 changes in sbcl-1.2.8 relative to sbcl-1.2.7:
   * enhancement: better error and warning messages. (lp#1314767, lp#736383)
diff --git a/src/code/array.lisp b/src/code/array.lisp
index 3e55f3b..8dfa801 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -1194,7 +1194,8 @@ of specialized arrays is supported."
                  (declare (ignore old-end))
                  (let ((new-data (if (or (and (array-header-p array)
                                               (%array-displaced-p array))
-                                         (> new-length old-length))
+                                         (> new-length old-length)
+                                         (not (adjustable-array-p array)))
                                      (data-vector-from-inits
                                       dimensions new-length
                                       element-type
diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index fcbb1fc..a5735eb 100644
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -330,3 +330,10 @@
   ;; when converted to bytes
   (when (= sb-vm:n-fixnum-tag-bits 1)
     (assert-error (make-array (1- array-total-size-limit)) error)))
+
+(with-test (:name :adjust-non-adjustable-array)
+  (let* ((a (make-array '(2 3) :initial-contents '((0 1 2) (3 4 5))))
+         (b (adjust-array a '(2 2))))
+    (setf (aref a 0 0) 11)
+    (assert (zerop (aref b 0 0)))
+    (assert (not (eq a b)))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL