From c6b052b5c190f24ac8e03d69bfc5d333f268b960 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 31 May 2004 00:21:28 +0000 Subject: [PATCH] 0.8.10.68: Fixed BUG 315 "no bounds check for access to displaced array" (reported by Bruno Haible) ... ARRAY-DIMENSION now signals an DISPLACED-TO-ARRAY-TOO-SMALL-ERROR when called on a displaced array, whose displaced-to array has been adjusted out of bounds. ... Test case. --- BUGS | 26 -------------------------- NEWS | 3 +++ package-data-list.lisp-expr | 1 + src/code/array.lisp | 20 +++++++++++++++++++- src/code/condition.lisp | 6 ++++++ tests/array.pure.lisp | 14 ++++++++++++++ version.lisp-expr | 2 +- 7 files changed, 44 insertions(+), 28 deletions(-) diff --git a/BUGS b/BUGS index e5b063c..19aeb2e 100644 --- a/BUGS +++ b/BUGS @@ -1314,32 +1314,6 @@ WORKAROUND: Expected: (2 6 15 38) Got: ERROR -315: "no bounds check for access to displaced array" - reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP - test suite. - (locally (declare (optimize (safety 3) (speed 0))) - (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character - :initial-element #\space :adjustable t)) - (y (make-array 10 :fill-pointer 4 :element-type 'character - :displaced-to x))) - (adjust-array x '(5)) - (char y 5))) - - SBCL fails this because (array-dimension y 0) return 10 even after the - adjustment, and hence the bounds-check passes. This is strictly - speaking legal, since the dictionary entry for ADJUST-ARRAY - says: - - "If A is displaced to B, the consequences are unspecified if B is - adjusted in such a way that it no longer has enough elements to - satisfy A." - - Should this be left as is, or should ARRAY-DIMENSION see if the - displaced-to array has shrunk too much and signal an error? An error - would probably be preferable, since a test of that form but with - (setf (char y 5) #\Space) potentially corrupts the heap and - certainly confuses the world if that string is used by C code. - 317: "FORMAT of floating point numbers" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP test suite. diff --git a/NEWS b/NEWS index 3681d6a..5bf1739 100644 --- a/NEWS +++ b/NEWS @@ -2415,6 +2415,9 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10: beginnings of a semantically meaningful condition hierarchy is under development, for use in SB-EXT:MUFFLE-CONDITIONS and by IDEs. + * fixed bug: Displaced arrays whose displaced-to array has become + too small now cause ARRAY-DIMENSION to signal an error, providing + for safer bounds-checking. (reported by Bruno Haible) * fixed bug: DEFCLASS slot definitions with identical :READER and :WRITER names now signal a reasonable error. (reported by Thomas Burdick) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index d842cc5..9315fca 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1104,6 +1104,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "DEFINED-FTYPE-MATCHES-DECLARED-FTYPE-P" "!DEFSTRUCT-WITH-ALTERNATE-METACLASS" "DESCEND-INTO" + "DISPLACED-TO-ARRAY-TOO-SMALL-ERROR" "DIVISION-BY-ZERO-ERROR" "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-HIGH-BITS" "DOUBLE-FLOAT-INT-EXPONENT" "DOUBLE-FLOAT-LOW-BITS" diff --git a/src/code/array.lisp b/src/code/array.lisp index 0a76afa..d300256 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -538,7 +538,25 @@ (error "Axis number ~W is too big; ~S only has ~D dimension~:P." axis-number array (%array-rank array))) (t - (%array-dimension array axis-number)))) + ;; ANSI sayeth (ADJUST-ARRAY dictionary entry): + ;; + ;; "If A is displaced to B, the consequences are + ;; unspecified if B is adjusted in such a way that it no + ;; longer has enough elements to satisfy A. + ;; + ;; In situations where this matters we should be doing a + ;; bounds-check, which in turn uses ARRAY-DIMENSION -- so + ;; this seems like a good place to signal an error. + (multiple-value-bind (target offset) (array-displacement array) + (when (and target + (> (array-total-size array) + (- (array-total-size target) offset))) + (error 'displaced-to-array-too-small-error + :format-control "~@" + :format-arguments (list (array-total-size array) + (- (array-total-size target) offset)))) + (%array-dimension array axis-number))))) (defun array-dimensions (array) #!+sb-doc diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 43e034d..0ab79c7 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -979,6 +979,12 @@ :references (list '(:ansi-cl :function make-array) '(:ansi-cl :function upgraded-array-element-type)))) +(define-condition displaced-to-array-too-small-error + (reference-condition simple-error) + () + (:default-initargs + :references (list '(:ansi-cl :function adjust-array)))) + (define-condition type-warning (reference-condition simple-warning) () (:default-initargs :references (list '(:sbcl :node "Handling of Types")))) diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index 098cd0e..25d7bea 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -159,3 +159,17 @@ (let ((x (make-array nil :initial-element 'foo))) (adjust-array x nil) (assert (eql (aref x) 'foo))) + +;;; BUG 315: "no bounds check for access to displaced array" +;;; reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP +;;; test suite. +(multiple-value-bind (val err) + (ignore-errors + (locally (declare (optimize (safety 3) (speed 0))) + (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character + :initial-element #\space :adjustable t)) + (y (make-array 10 :fill-pointer 4 :element-type 'character + :displaced-to x))) + (adjust-array x '(5)) + (char y 5)))) + (assert (and (not val) (typep err 'sb-kernel:displaced-to-array-too-small-error)))) diff --git a/version.lisp-expr b/version.lisp-expr index 594b0ee..6989d69 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.10.67" +"0.8.10.68" -- 1.7.10.4