From 7861b0dc2f09dcb83de3c0addf534029d9906b5c Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 1 Mar 2004 16:21:14 +0000 Subject: [PATCH] 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). --- NEWS | 4 ++++ src/code/array.lisp | 19 +++++++++++++++---- tests/array.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 4 files changed, 24 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index c66aa88..31d5983 100644 --- 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 --- 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))) ;;;; 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 --- 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 --- 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" -- 1.7.10.4