From: Stas Boukarev <stassats@gmail.com>
Date: Mon, 1 Apr 2013 13:59:28 +0000 (+0400)
Subject: Check bounds of ELT on &more in safe code.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e626db9d157d8790efe3762a7f46cc347161f8e8;p=sbcl.git

Check bounds of ELT on &more in safe code.

Disable &more optimizations for ELT if safety = 3.
---

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 2fc68a9..5858da9 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -4152,10 +4152,12 @@
         `(car (nthcdr ,n ,list)))))
 
 (define-source-transform elt (seq n)
-  (multiple-value-bind (context count) (possible-rest-arg-context seq)
-    (if context
-        `(%rest-ref ,n ,seq ,context ,count)
-        (values nil t))))
+  (if (policy *lexenv* (= safety 3))
+      (values nil t)
+      (multiple-value-bind (context count) (possible-rest-arg-context seq)
+        (if context
+            `(%rest-ref ,n ,seq ,context ,count)
+            (values nil t)))))
 
 ;;; CAxR -> %REST-REF
 (defun source-transform-car (list nth)
diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index 2941097..78d9b27 100644
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -370,3 +370,10 @@
                                     (t #'shuffle))
                                   size type)
                          #'< :key #'car))))))))
+
+(with-test (:name &more-elt-index-too-large)
+  (assert (raises-error? (funcall
+                          (compile nil '(lambda (&rest args)
+                                         (declare (optimize safety))
+                                         (elt args 0))))
+                         sb-kernel:index-too-large-error)))