Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

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)