From 09cd508206ea4d5da08d3950f9cddb862e81dffd Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 27 Jul 2003 15:05:31 +0000 Subject: [PATCH] 0.8.2.3: * Fixed bug reported by Kalle Olavi Niemitalo on Debian CMUCL BTS: MAKE-ARRAY ignored :INITIAL-CONTENTS NIL. --- NEWS | 6 ++++-- src/code/array.lisp | 37 ++++++++++++++++++++----------------- src/compiler/checkgen.lisp | 6 +++--- tests/array.pure.lisp | 8 ++++++-- version.lisp-expr | 2 +- 5 files changed, 34 insertions(+), 25 deletions(-) diff --git a/NEWS b/NEWS index 39d85a8..2b719d8 100644 --- a/NEWS +++ b/NEWS @@ -1941,9 +1941,11 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2: * bug fix: WITH-OUTPUT-TO-STRING (and MAKE-STRING-OUTPUT-STREAM) now accept and act upon their :ELEMENT-TYPE keyword argument. (reported by Edi Weitz) - * bug fix: FILE-POSITION now accepts position designators up to - ARRAY-DIMENSION-LIMIT or the extreme of the off_t range, whichever + * bug fix: FILE-POSITION now accepts position designators up to + ARRAY-DIMENSION-LIMIT or the extreme of the off_t range, whichever is the greater. (thanks to Patrik Nordebo) + * bug fix: MAKE-ARRAY ignored :INITIAL-CONTENTS NIL. (reported by + Kalle Olavi Niemitalo) 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 c8e0c86..6e46a9d 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -127,7 +127,8 @@ (defun make-array (dimensions &key (element-type t) (initial-element nil initial-element-p) - initial-contents adjustable fill-pointer + (initial-contents nil initial-contents-p) + adjustable fill-pointer displaced-to displaced-index-offset) (let* ((dimensions (if (listp dimensions) dimensions (list dimensions))) (array-rank (length (the list dimensions))) @@ -155,8 +156,8 @@ (declare (type index length)) (when initial-element-p (fill array initial-element)) - (when initial-contents - (when initial-element + (when initial-contents-p + (when initial-element-p (error "can't specify both :INITIAL-ELEMENT and ~ :INITIAL-CONTENTS")) (unless (= length (length initial-contents)) @@ -171,7 +172,8 @@ (data (or displaced-to (data-vector-from-inits dimensions total-size element-type - initial-contents initial-element initial-element-p))) + initial-contents initial-contents-p + initial-element initial-element-p))) (array (make-array-header (cond ((= array-rank 1) (%complex-vector-widetag element-type)) @@ -201,7 +203,7 @@ (setf (%array-available-elements array) total-size) (setf (%array-data-vector array) data) (cond (displaced-to - (when (or initial-element-p initial-contents) + (when (or initial-element-p initial-contents-p) (error "Neither :INITIAL-ELEMENT nor :INITIAL-CONTENTS ~ can be specified along with :DISPLACED-TO")) (let ((offset (or displaced-index-offset 0))) @@ -223,9 +225,9 @@ ;;; to FILL-DATA-VECTOR for error checking on the structure of ;;; initial-contents. (defun data-vector-from-inits (dimensions total-size element-type - initial-contents initial-element - initial-element-p) - (when (and initial-contents initial-element-p) + 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 either MAKE-ARRAY or ADJUST-ARRAY.")) (let ((data (if initial-element-p @@ -240,7 +242,7 @@ (error "~S cannot be used to initialize an array of type ~S." initial-element element-type)) (fill (the vector data) initial-element))) - (initial-contents + (initial-contents-p (fill-data-vector data dimensions initial-contents))) data)) @@ -659,7 +661,8 @@ (defun adjust-array (array dimensions &key (element-type (array-element-type array)) (initial-element nil initial-element-p) - initial-contents fill-pointer + (initial-contents nil initial-contents-p) + fill-pointer displaced-to displaced-index-offset) #!+sb-doc "Adjust ARRAY's dimensions to the given DIMENSIONS and stuff." @@ -674,7 +677,7 @@ (declare (fixnum array-rank)) (when (and fill-pointer (> array-rank 1)) (error "Multidimensional arrays can't have fill pointers.")) - (cond (initial-contents + (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 ~ @@ -682,8 +685,8 @@ (let* ((array-size (apply #'* dimensions)) (array-data (data-vector-from-inits dimensions array-size element-type - initial-contents initial-element - initial-element-p))) + initial-contents initial-contents-p + initial-element initial-element-p))) (if (adjustable-array-p array) (set-array-header array array-data array-size (get-new-fill-pointer array array-size @@ -734,8 +737,8 @@ (setf new-data (data-vector-from-inits dimensions new-length element-type - initial-contents initial-element - initial-element-p)) + initial-contents initial-contents-p + initial-element initial-element-p)) (replace new-data old-data :start2 old-start :end2 old-end)) (t (setf new-data @@ -757,8 +760,8 @@ (> new-length old-length)) (data-vector-from-inits dimensions new-length - element-type () initial-element - initial-element-p) + element-type () nil + initial-element initial-element-p) old-data))) (if (or (zerop old-length) (zerop new-length)) (when initial-element-p (fill new-data initial-element)) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 4958c90..5313441 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -467,9 +467,9 @@ (do-blocks (block component) (when (block-type-check block) (do-nodes (node cont block) - (when (cast-p node) - (when (cast-type-check node) - (cast-check-uses node)) + (when (and (cast-p node) + (cast-type-check node)) + (cast-check-uses node) (cond ((worth-type-check-p node) (casts (cons node (not (probable-type-check-p node))))) (t diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index 60eb661..023e170 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -138,6 +138,10 @@ ;; dimensions that we promised. Let's make sure that we can create ;; an array with more than 2^24 elements, since that was a symptom ;; from the CLISP and OpenMCL hosts. - (let ((big-array (opaque-identity + (let ((big-array (opaque-identity (make-array (expt 2 26) :element-type 'bit)))) - (assert (= (length big-array) (expt 2 26))))) \ No newline at end of file + (assert (= (length big-array) (expt 2 26))))) + +;;; Bug reported by Kalle Olavi Niemitalo for CMUCL through Debian BTS +(let ((array (make-array nil :initial-contents nil))) + (assert (eql (aref array) nil))) diff --git a/version.lisp-expr b/version.lisp-expr index 3a7afaa..865410d 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.2.2" +"0.8.2.3" -- 1.7.10.4