From a3257f4d8b56beb7e2f1c421b7c9bb1d05f85a7a Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Fri, 12 May 2000 20:54:36 +0000 Subject: [PATCH] Fix array-displacement to correctly handle non-displaced arrays; it wasn't even checking that the array had a header causing random data to be returned when passed a simple-array. Ndote by Sam Steingold, with suggestions from Raymond Toy. --- code/array.lisp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/code/array.lisp b/code/array.lisp index 3602f91b8..984eaf196 100644 --- a/code/array.lisp +++ b/code/array.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.29 1998/07/24 17:17:49 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.30 2000/05/12 20:54:36 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -583,7 +583,10 @@ "Returns values of :displaced-to and :displaced-index-offset options to make-array, or the defaults nil and 0 if not a displaced array." (declare (array array)) - (values (%array-data-vector array) (%array-displacement array))) + (if (and (array-header-p array) (%array-displaced-p array)) + (values (%array-data-vector array) + (truly-the fixnum (%array-displacement array))) + (values nil 0))) (defun adjustable-array-p (array) "Returns T if (adjust-array array...) would return an array identical -- GitLab