From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 4 Apr 2010 09:03:08 +0000 (+0000)
Subject: 1.0.37.36: revisit FIND/POSITION bounds checking on lists
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dd92bd1d2fff942e6a38542364be21fa256cb4c0;p=sbcl.git

1.0.37.36: revisit FIND/POSITION bounds checking on lists

  The spec doesn't actually /require/ us to signal an error if we
  are not in danger of running out of bounds as far as I can tell.

  So don't traverse the entire list during forward searches if we
  find what we are looking for before specified :END or the list end.

  Patch by Alec Berryman.

  This revisits lp#452008, and fixed lp#554385.
---

diff --git a/NEWS b/NEWS
index d0cd1d4..f6228a5 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,5 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
-changes relative to sbcl-1.0.36:
+changes relative to sbcl-1.0.37:
   * INCOMPATIBLE CHANGE: Thread names are now restricted to SIMPLE-STRINGs
     like for any other thread-related datastructure (MUTEX, etc.)
   * DEPRECATION: the SB-QUEUE contrib was merged into the SB-CONCURRENCY
@@ -48,6 +48,9 @@ changes relative to sbcl-1.0.36:
     CONDITION-NOTIFY on Linux. See threads "lost wakeup in condition-wait /
     condition-notify" (Feb 2010) and "Condition-Wait, Deadline handler, waking
     up itself" (March 2010) for further details.
+  * bug fix: allow forward FIND and POSITION on lists to elide checking :END
+    against length of the list if the element is found before the specified
+    END is reached. (thanks to Alec Berryman, lp#554385)
 
 changes in sbcl-1.0.37 relative to sbcl-1.0.36:
   * enhancement: Backtrace from THROW to uncaught tag on x86oids now shows
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 466496d..68aa5b3 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -1237,9 +1237,7 @@
                                              (if from-end
                                                  (setf find element
                                                        position index)
-                                                 (unless find
-                                                   (setf find element
-                                                         position index)))))))))))))
+                                                 (return (values element index)))))))))))))
   (def %find-position-if when)
   (def %find-position-if-not unless))
 
diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index eb75013..2c1d638 100644
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -224,16 +224,16 @@
                            (second got) ',lambda)))))
     (test sb-kernel:bounding-indices-bad-error
           (lambda ()
-            (find :foo '(1 2 3 :foo) :start 1 :end 5)))
+            (find :foo '(1 2 3 :foo) :start 1 :end 5 :from-end t)))
     (test sb-kernel:bounding-indices-bad-error
           (lambda ()
-            (position :foo '(1 2 3 :foo) :start 1 :end 5)))
+            (position :foo '(1 2 3 :foo) :start 1 :end 5 :from-end t)))
     (test sb-kernel:bounding-indices-bad-error
           (lambda ()
-            (find :foo '(1 2 3 :foo) :start 3 :end 0)))
+            (find :foo '(1 2 3 :foo) :start 3 :end 0 :from-end t)))
     (test sb-kernel:bounding-indices-bad-error
           (lambda ()
-            (position :foo '(1 2 3 :foo) :start 3 :end 0)))
+            (position :foo '(1 2 3 :foo) :start 3 :end 0 :from-end t)))
     (test type-error
           (lambda ()
             (let ((list (list 1 2 3 :foo)))
@@ -242,3 +242,11 @@
           (lambda ()
             (let ((list (list 1 2 3 :foo)))
               (position :bar (nconc list list)))))))
+
+(with-test (:name :bug-554385)
+  ;; FIND-IF shouldn't look through the entire list.
+  (assert (= 2 (find-if #'evenp '(1 2 1 1 1 1 1 1 1 1 1 1 :foo))))
+  ;; Even though the end bounds are incorrect, the
+  ;; element is found before that's an issue.
+  (assert (eq :foo (find :foo '(1 2 3 :foo) :start 1 :end 5)))
+  (assert (= 3 (position :foo '(1 2 3 :foo) :start 1 :end 5))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 3441c01..ce63ee5 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.35"
+"1.0.37.36"