From ee88d43e33e7af19e678ee3d2e6228e98a7c1d65 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Fri, 4 Jan 2008 01:52:28 +0000 Subject: [PATCH] 1.0.13.15: Fix some VECTOR-PUSH-EXTEND problems * Ensure that the vector is always extended by at least one element when full, even if MIN-EXTENSION is smaller than 1. (Prevents array index overflows). * Don't try to extend a vector beyond ARRAY-DIMENSION-LIMIT. * Patch by Paul Khuong. --- src/code/array.lisp | 9 ++++++--- version.lisp-expr | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/code/array.lisp b/src/code/array.lisp index 4268f55..78bf43d 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -818,12 +818,15 @@ of specialized arrays is supported." (defun vector-push-extend (new-element vector &optional - (extension (1+ (length vector)))) - (declare (vector vector) (fixnum extension)) + (min-extension + (let ((length (length vector))) + (min (1+ length) + (- array-dimension-limit length))))) + (declare (vector vector) (fixnum min-extension)) (let ((fill-pointer (fill-pointer vector))) (declare (fixnum fill-pointer)) (when (= fill-pointer (%array-available-elements vector)) - (adjust-array vector (+ fill-pointer extension))) + (adjust-array vector (+ fill-pointer (max 1 min-extension)))) ;; disable bounds checking (locally (declare (optimize (safety 0))) (setf (aref vector fill-pointer) new-element)) diff --git a/version.lisp-expr b/version.lisp-expr index 07453ed..ec756fc 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".) -"1.0.13.14" +"1.0.13.15" -- 1.7.10.4