Commit ee3f2e03 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

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.
parent d95f1e64

package-data-list.lisp-expr

+2 −1
Original line number Diff line number Diff line
@@ -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"

src/code/array.lisp

+10 −13
Original line number Diff line number Diff line
@@ -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))))

src/code/condition.lisp

+15 −0
Original line number Diff line number Diff line
@@ -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

src/code/interr.lisp

+1 −6
Original line number Diff line number Diff line
@@ -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

tests/array.pure.lisp

+11 −0
Original line number Diff line number Diff line
@@ -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)))))))