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