Raymond Toy pushed to branch master at cmucl / cmucl

Commits: 5a1ecf1a by Raymond Toy at 2015-08-01T13:24:07Z Fix #4 again, but for negative indices.

o Add declaration for LIST-ELT* that the index is a kerrnel:index. o Clean up ELT to directly call LIST-ELT* instead of having an inlined version. o Fix typo: issue.5 is really issue.4. o Add tests for invalid indices for ELT and (SETF ELT) for both lists and vectors.

- - - - -

2 changed files:

- src/code/seq.lisp - tests/issues.lisp

Changes:

===================================== src/code/seq.lisp ===================================== --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -139,7 +139,8 @@ (make-sequence-of-type (result-type-or-lose type) length))))

(defun list-elt* (sequence index) - (declare (type list sequence)) + (declare (type list sequence) + (type kernel:index index)) (do ((count index (1- count)) (list sequence (cdr list))) ((= count 0) @@ -152,13 +153,7 @@ "Returns the element of SEQUENCE specified by INDEX." (etypecase sequence (list - (do ((count index (1- count)) - (list sequence (cdr list))) - ((= count 0) - (if (endp list) - (signal-index-too-large-error sequence index) - (car list))) - (declare (type (integer 0) count)))) + (list-elt* sequence index)) (vector (when (>= index (length sequence)) (signal-index-too-large-error sequence index))

===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -24,20 +24,46 @@ '(square x) (funcall (compiler-macro-function 'square) '(funcall #'square x) nil)))

-(define-test issue.5 - (:tag :issues) - (assert-true - (handler-case - (let ((f (compile nil '(lambda (list) - (declare (type list list) - (optimize (speed 1) (safety 1) (compilation-speed 1) (space 1) (debug 1))) - (elt list 3))))) - (funcall f (list 0 1 2))) - ;; ELT should signal an error in this case. - (lisp::index-too-large-error () - t) - (t () - nil)))) +(define-test issue.4 + (:tag :issues) + ;; Compile up two versions of elt. F-LIST should get transformed to + ;; LISP::LISP-ELT*, and F-VEC should be converted to AREF. Both of + ;; thse should signal errors. + (let ((f-list (compile nil '(lambda (list n) + (declare (type list list) + (optimize (speed 1) (safety 1) (compilation-speed 1) + (space 1) (debug 1))) + (elt list n)))) + (f-vec (compile nil '(lambda (vec n) + (declare (type (simple-array * (*)) vec) + (optimize (speed 1) (safety 1) (compilation-speed 1) + (space 1) (debug 1))) + (elt vec n))))) + ;; Errors because the index is beyond the end of the sequence + (assert-error 'lisp::index-too-large-error (funcall f-list (list 0 1 2) 3)) + (assert-error 'type-error (funcall f-vec (make-array 3 :initial-contents '(0 1 2)) 3)) + ;; Errors because the index is negative. + (assert-error 'type-error (funcall f-list (list 0 1 2) -1)) + (assert-error 'type-error (funcall f-vec (make-array 3 :initial-contents '(0 1 2)) -1)))) + +(define-test issue.4.setters + (:tag :issues) + ;; Compile up two versions of (SETF ELT). F-LIST should get transformed to + ;; %SETELT, and F-VEC should be converted to (SETF AREF). Both of + ;; thse should signal errors. + (let ((s-list (compile nil '(lambda (list n new) + (declare (type list list)) + (setf (elt list n) new)))) + (s-vec (compile nil '(lambda (vec n new) + (declare (type (simple-array * (*)) vec)) + (setf (elt vec n) new))))) + ;; Errors because the index is beyond the end of the sequence + (assert-error 'type-error (funcall s-list (list 0 1 2) 3 99)) + (assert-error 'type-error (funcall s-vec (make-array 3 :initial-contents '(0 1 2)) 3 99)) + ;; Errors because the index is negative. + (assert-error 'type-error (funcall s-list (list 0 1 2) -1 99)) + (assert-error 'type-error (funcall s-vec (make-array 3 :initial-contents '(0 1 2)) -1 99)))) +

;; Functions for testing issue-3 (defun sqr (x)

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5...