<html lang='en'>
<head>
<meta content='text/html; charset=utf-8' http-equiv='Content-Type'>
<title>
GitLab
</title>
</meta>
</head>
<style>
img {
max-width: 100%;
height: auto;
}
p.details {
font-style:italic;
color:#777
}
.footer p {
font-size:small;
color:#777
}
pre.commit-message {
white-space: pre-wrap;
}
.file-stats a {
text-decoration: none;
}
.file-stats .new-file {
color: #090;
}
.file-stats .deleted-file {
color: #B00;
}
</style>
<body>
<div class='content'>
<h3>Raymond Toy pushed to branch master at <a href="https://gitlab.common-lisp.net/cmucl/cmucl">cmucl / cmucl</a></h3>
<h4>
Commits:
</h4>
<ul>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5f3d82a8d5621c2">5a1ecf1a</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-08-01T13:24:07Z</i>
</div>
<pre class='commit-message'>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.</pre>
</li>
</ul>
<h4>2 changed files:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/seq.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-1'>
tests/issues.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5f3d82a8d5621c2#diff-0'>
<strong>
src/code/seq.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/seq.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/seq.lisp
</span><span style="color: #aaaaaa">@@ -139,7 +139,8 @@
</span> (make-sequence-of-type (result-type-or-lose type) length))))
(defun list-elt* (sequence index)
<span style="color: #000000;background-color: #ffdddd">- (declare (type list sequence))
</span><span style="color: #000000;background-color: #ddffdd">+ (declare (type list sequence)
+ (type kernel:index index))
</span> (do ((count index (1- count))
(list sequence (cdr list)))
((= count 0)
<span style="color: #aaaaaa">@@ -152,13 +153,7 @@
</span> "Returns the element of SEQUENCE specified by INDEX."
(etypecase sequence
(list
<span style="color: #000000;background-color: #ffdddd">- (do ((count index (1- count))
</span>- (list sequence (cdr list)))
- ((= count 0)
- (if (endp list)
- (signal-index-too-large-error sequence index)
- (car list)))
<span style="color: #000000;background-color: #ffdddd">- (declare (type (integer 0) count))))
</span><span style="color: #000000;background-color: #ddffdd">+ (list-elt* sequence index))
</span> (vector
(when (>= index (length sequence))
(signal-index-too-large-error sequence index))
</code></pre>
<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5f3d82a8d5621c2#diff-1'>
<strong>
tests/issues.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/tests/issues.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/tests/issues.lisp
</span><span style="color: #aaaaaa">@@ -24,20 +24,46 @@
</span> '(square x)
(funcall (compiler-macro-function 'square) '(funcall #'square x) nil)))
-(define-test issue.5
<span style="color: #000000;background-color: #ffdddd">- (:tag :issues)
- (assert-true
- (handler-case
- (let ((f (compile nil '(lambda (list)
</span>- (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)))
<span style="color: #000000;background-color: #ffdddd">- ;; ELT should signal an error in this case.
- (lisp::index-too-large-error ()
- t)
- (t ()
- nil))))
</span><span style="color: #000000;background-color: #ddffdd">+(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))))
+
</span>
;; Functions for testing issue-3
(defun sqr (x)
</code></pre>
<br>
</li>
</div>
<div class='footer' style='margin-top: 10px;'>
<p>
—
<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5f3d82a8d5621c2">View it on GitLab</a>
<script type="application/ld+json">{"@context":"http://schema.org","@type":"EmailMessage","action":{"@type":"ViewAction","name":"View Commit","url":"https://gitlab.common-lisp.net/cmucl/cmucl/commit/5a1ecf1aa15fd6b5a3b4bac0c5f3d82a8d5621c2"}}</script>
</p>
</div>
</body>
</html>