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:
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)