diff --git a/arrays.lisp b/arrays.lisp index 670880fe996c1a9d770040823a0a26c9e3ee9199..76c18791ad5f416acafb9a119b401329b9dbf78e 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -1,20 +1,18 @@ (in-package :alexandria) -(defun copy-array (array &key - (element-type (array-element-type array)) - (fill-pointer (and (array-has-fill-pointer-p array) - (fill-pointer array))) - (adjustable (adjustable-array-p array))) +(defun copy-array (array &key (element-type (array-element-type array)) + (fill-pointer (and (array-has-fill-pointer-p array) + (fill-pointer array))) + (adjustable (adjustable-array-p array))) "Returns an undisplaced copy of ARRAY, with same fill-pointer and adjustability (if any) as the original, unless overridden by the keyword -arguments. Performance depends on efficiency of general ADJUST-ARRAY in the -host lisp -- for most cases a special purpose copying function is likely to -perform better." - (let ((dims (array-dimensions array))) - ;; Dictionary entry for ADJUST-ARRAY requires adjusting a - ;; displaced array to a non-displaced one to make a copy. - (adjust-array - (make-array dims - :element-type element-type :fill-pointer fill-pointer - :adjustable adjustable :displaced-to array) - dims))) +arguments." + (let* ((dimensions (array-dimensions array)) + (new-array (make-array dimensions + :element-type element-type + :adjustable adjustable + :fill-pointer fill-pointer))) + (dotimes (i (array-total-size array)) + (setf (row-major-aref new-array i) + (row-major-aref array i))) + new-array)) diff --git a/tests.lisp b/tests.lisp index ef7d19d38c1b74fbd9be55f38e661bc8aa2a6c51..cb1978ceedc551d81c736afa27abfef593ccf487 100644 --- a/tests.lisp +++ b/tests.lisp @@ -29,6 +29,24 @@ (eql (fill-pointer orig) (fill-pointer copy))))) nil t t t) +(deftest copy-array.3 + (let* ((orig (vector 1 2 3)) + (copy (copy-array orig))) + (typep copy 'simple-array)) + t) + +(deftest copy-array.4 + (let ((orig (make-array 21 + :adjustable t + :fill-pointer 0))) + (dotimes (n 42) + (vector-push-extend n orig)) + (let ((copy (copy-array orig + :adjustable nil + :fill-pointer nil))) + (typep copy 'simple-array))) + t) + (deftest array-index.1 (typep 0 'array-index) t)