Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1ca0a557 by Raymond Toy at 2015-06-14T08:31:14Z Fix #4: ELT signals error on invalid index on lists code/seq.lisp: o Define internal LIST-ELT* function that executes ELT on lists, signaling an error if the index is invalid. compiler/seqtran.lisp: o Change the deftransform for ELT to use LIST-ELT* instead of NTH. tests/issues.lisp: o Add test for this issue. - - - - - 3 changed files: - src/code/seq.lisp - src/compiler/seqtran.lisp - tests/issues.lisp Changes: ===================================== src/code/seq.lisp ===================================== --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -138,6 +138,16 @@ (t (make-sequence-of-type (result-type-or-lose type) length)))) +(defun list-elt* (sequence index) + (declare (type list sequence)) + (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)))) + (defun elt (sequence index) "Returns the element of SEQUENCE specified by INDEX." (etypecase sequence ===================================== src/compiler/seqtran.lisp ===================================== --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -107,8 +107,8 @@ (deftransform elt ((s i) ((simple-array * (*)) *) * :when :both) '(aref s i)) -(deftransform elt ((s i) (list *) * :when :both :policy (< safety 3)) - '(nth i s)) +(deftransform elt ((s i) (list *) * :when :both) + '(lisp::list-elt* s i)) (deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both) '(%aset s i v)) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -23,3 +23,18 @@ (assert-equal '(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)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca0a5571183b014a50fad56be...