<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/1ca0a5571183b014a50fad56bea89472a47c1e8b">1ca0a557</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-06-14T08:31:14Z</i>
</div>
<pre class='commit-message'>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.</pre>
</li>
</ul>
<h4>3 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'>
src/compiler/seqtran.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-2'>
tests/issues.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca0a5571183b014a50fad56bea89472a47c1e8b#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">@@ -138,6 +138,16 @@
</span> (t
(make-sequence-of-type (result-type-or-lose type) length))))
<span style="color: #000000;background-color: #ddffdd">+(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))))
+
</span> (defun elt (sequence index)
"Returns the element of SEQUENCE specified by INDEX."
(etypecase sequence
</code></pre>
<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca0a5571183b014a50fad56bea89472a47c1e8b#diff-1'>
<strong>
src/compiler/seqtran.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/compiler/seqtran.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/compiler/seqtran.lisp
</span><span style="color: #aaaaaa">@@ -107,8 +107,8 @@
</span> (deftransform elt ((s i) ((simple-array * (*)) *) * :when :both)
'(aref s i))
-(deftransform elt ((s i) (list *) * :when :both :policy (< safety 3))
<span style="color: #000000;background-color: #ffdddd">- '(nth i s))
</span><span style="color: #000000;background-color: #ddffdd">+(deftransform elt ((s i) (list *) * :when :both)
+ '(lisp::list-elt* s i))
</span>
(deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both)
'(%aset s i v))
</code></pre>
<br>
</li>
<li id='diff-2'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca0a5571183b014a50fad56bea89472a47c1e8b#diff-2'>
<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">@@ -23,3 +23,18 @@
</span> (assert-equal
'(square x)
(funcall (compiler-macro-function 'square) '(funcall #'square x) nil)))
<span style="color: #000000;background-color: #ddffdd">+
+(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))))
</span></code></pre>
<br>
</li>
</div>
<div class='footer' style='margin-top: 10px;'>
<p>
—
<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/1ca0a5571183b014a50fad56bea89472a47c1e8b">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/1ca0a5571183b014a50fad56bea89472a47c1e8b"}}</script>
</p>
</div>
</body>
</html>