From: Stas Boukarev <stassats@gmail.com>
Date: Sat, 5 Jan 2013 15:43:05 +0000 (+0400)
Subject: adjust-array: Make sure that :initial-element is used.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bab82fcf13993d008a4751cc143bde298613c22a;p=sbcl.git

adjust-array: Make sure that :initial-element is used.

Adjust-array ignored :initial-element for arrays of type T.

Fixes lp#1096359.
---

diff --git a/NEWS b/NEWS
index 666ead1..bd77788 100644
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes relative to sbcl-1.1.3:
   * bug fix: very long (or infinite) constant lists in DOLIST do not result
     in very long compile times or heap exhaustion anymore. (lp#1095488)
   * bug fix: `#3(1) is read as #(1 1 1), not as #(1). (lp#1095918)
+  * bug fix: adjust-array ignored :initial-element for simple-vectors.
+    (lp#1096359)
 
 changes in sbcl-1.1.3 relative to sbcl-1.1.2:
   * enhancement: warnings about bad locale settings, LANG, LC_CTYPE, etc.
diff --git a/src/code/array.lisp b/src/code/array.lisp
index 7122723..b5e3999 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -304,25 +304,18 @@ of specialized arrays is supported."
                                element-type widetag
                                initial-contents initial-contents-p
                                initial-element initial-element-p)
-  (when (and initial-contents-p initial-element-p)
-    (error "cannot supply both :INITIAL-CONTENTS and :INITIAL-ELEMENT to
+  (when initial-element-p
+    (when initial-contents-p
+      (error "cannot supply both :INITIAL-CONTENTS and :INITIAL-ELEMENT to
             either MAKE-ARRAY or ADJUST-ARRAY."))
-  (let ((data (cond
-                (widetag
-                 (allocate-vector-with-widetag widetag total-size))
-                (initial-element-p
-                 (make-array total-size
-                             :element-type element-type
-                             :initial-element initial-element))
-                (t
-                 (make-array total-size
-                             :element-type element-type)))))
+    (unless (typep initial-element element-type)
+      (error "~S cannot be used to initialize an array of type ~S."
+             initial-element element-type)))
+  (let ((data (if widetag
+                  (allocate-vector-with-widetag widetag total-size)
+                  (make-array total-size :element-type element-type))))
     (cond (initial-element-p
-           (unless (simple-vector-p data)
-             (unless (typep initial-element element-type)
-               (error "~S cannot be used to initialize an array of type ~S."
-                      initial-element element-type))
-             (fill (the vector data) initial-element)))
+           (fill (the vector data) initial-element))
           (initial-contents-p
            (fill-data-vector data dimensions initial-contents)))
     data))
@@ -916,7 +909,7 @@ of specialized arrays is supported."
       (cond (initial-contents-p
              ;; array former contents replaced by INITIAL-CONTENTS
              (if (or initial-element-p displaced-to)
-                 (error "INITIAL-CONTENTS may not be specified with ~
+                 (error ":INITIAL-CONTENTS may not be specified with ~
                          the :INITIAL-ELEMENT or :DISPLACED-TO option."))
              (let* ((array-size (apply #'* dimensions))
                     (array-data (data-vector-from-inits
diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp
index 901beba..442358e 100644
--- a/tests/array.pure.lisp
+++ b/tests/array.pure.lisp
@@ -283,3 +283,8 @@
                   (compile nil '(lambda (m) (make-array m 1)))
                 (simple-warning () :good)))))
 
+
+(with-test (:name :bug-1096359)
+  (let ((a (make-array 1 :initial-element 5)))
+    (assert (equalp (adjust-array a 2 :initial-element 10)
+                    #(5 10)))))