From: Nikodemus Siivola Date: Mon, 12 Jan 2009 11:26:42 +0000 (+0000) Subject: 1.0.24.36: don't print the array object when reporting index out of bounds X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=ee3f2e0351674dde7229afdcccfcfaf8ce5b112e;p=sbcl.git 1.0.24.36: don't print the array object when reporting index out of bounds * Report the type of the array instead, and encapsulate the array object in the condition object so that it can still be inspected manually. * Suggested by Stas Boukarev. --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index a5aacee..7c1f98b 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -875,6 +875,7 @@ possibly temporariliy, because it might be used internally." "COMPILED-PROGRAM-ERROR" "ENCAPSULATED-CONDITION" "INTERPRETED-PROGRAM-ERROR" + "INVALID-ARRAY-INDEX-ERROR" "SIMPLE-CONTROL-ERROR" "SIMPLE-FILE-ERROR" "SIMPLE-PARSE-ERROR" "SIMPLE-PROGRAM-ERROR" "SIMPLE-READER-ERROR" @@ -1410,7 +1411,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." #!+win32 "HANDLE-WIN32-EXCEPTION" "INTERNAL-TIME" "INTERSECTION-TYPE" "INTERSECTION-TYPE-P" "INTERSECTION-TYPE-TYPES" "INVALID-ARG-COUNT-ERROR" - "INVALID-ARRAY-INDEX-ERROR" "INVALID-UNWIND-ERROR" + "INVALID-UNWIND-ERROR" "IRRATIONAL" "JUST-DUMP-IT-NORMALLY" "KEY-INFO" "KEY-INFO-NAME" "KEY-INFO-P" "KEY-INFO-TYPE" "LAYOUT-DEPTHOID" "LAYOUT-INVALID-ERROR" diff --git a/src/code/array.lisp b/src/code/array.lisp index 266c737..7e9a28d 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -476,6 +476,14 @@ of specialized arrays is supported." (defun data-vector-ref-with-offset (array index offset) (hairy-data-vector-ref array (+ index offset))) +(declaim (ftype (function (array integer integer &optional t) nil) signal-invalid-array-index-error)) +(defun invalid-array-index-error (array index bound &optional axis) + (error 'invalid-array-index-error + :array array + :axis axis + :datum index + :type `(integer 0 (,bound)))) + ;;; SUBSCRIPTS has a dynamic-extent list structure and is destroyed (defun %array-row-major-index (array subscripts &optional (invalid-index-error-p t)) @@ -497,11 +505,7 @@ of specialized arrays is supported." (declare (fixnum dim)) (unless (and (fixnump index) (< -1 index dim)) (if invalid-index-error-p - (error 'simple-type-error - :format-control "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S" - :format-arguments (list index axis array) - :datum index - :expected-type `(integer 0 (,dim))) + (invalid-array-index-error array index dim axis) (return-from %array-row-major-index nil))) (incf result (* chunk-size (the fixnum index))) (setf chunk-size (* chunk-size dim)))) @@ -509,14 +513,7 @@ of specialized arrays is supported." (length (length (the (simple-array * (*)) array)))) (unless (and (fixnump index) (< -1 index length)) (if invalid-index-error-p - ;; FIXME: perhaps this should share a format-string - ;; with INVALID-ARRAY-INDEX-ERROR or - ;; INDEX-TOO-LARGE-ERROR? - (error 'simple-type-error - :format-control "invalid index ~W in ~S" - :format-arguments (list index array) - :datum index - :expected-type `(integer 0 (,length))) + (invalid-array-index-error array index length) (return-from %array-row-major-index nil))) index)))) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 2169ccd..a4fbb97 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1101,6 +1101,21 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) "No traps are enabled? How can this be?" stream)))))) +(define-condition invalid-array-index-error (type-error) + ((array :initarg :array :reader invalid-array-index-error-array) + (axis :initarg :axis :reader invalid-array-index-error-axis)) + (:report + (lambda (condition stream) + (let ((array (invalid-array-index-error-array condition))) + (format stream "Index ~W out of bounds for ~@[axis ~W of ~]~S, ~ + should be nonnegative and <~W." + (type-error-datum condition) + (when (> (array-rank array) 1) + (invalid-array-index-error-axis condition)) + (type-of array) + ;; Extract the bound from (INTEGER 0 (BOUND)) + (caaddr (type-error-expected-type condition))))))) + (define-condition index-too-large-error (type-error) () (:report diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 3b75632..232f1a6 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -260,12 +260,7 @@ :format-arguments (list key-name))) (deferr invalid-array-index-error (array bound index) - (error 'simple-type-error - :format-control - "invalid array index ~W for ~S (should be nonnegative and <~W)" - :format-arguments (list index array bound) - :datum index - :expected-type `(integer 0 (,bound)))) + (invalid-array-index-error array bound index)) (deferr object-not-simple-array-error (object) (error 'type-error diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index b07f5e3..2088758 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -249,3 +249,14 @@ (assert (not (array-has-fill-pointer-p (sb-ext::array-storage-vector (make-array 5 :fill-pointer 4))))))) + +(with-test (:name invalid-array-index-error) + (let ((array (make-array '(3 3 3)))) + (assert + (eq :right + (handler-case + (eval `(aref ,array 0 1 3)) + (sb-int:invalid-array-index-error (e) + (when (and (eq array (sb-kernel::invalid-array-index-error-array e)) + (= 3 (type-error-datum e))) + :right))))))) diff --git a/version.lisp-expr b/version.lisp-expr index 263560b..a0a5aa8 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.24.35" +"1.0.24.36"