~ chicken-core (chicken-5) e6723ded1f21a814f318bf8bf26a73fad15e3e6c


commit e6723ded1f21a814f318bf8bf26a73fad15e3e6c
Author:     Moritz Heidkamp <moritz.heidkamp@bevuta.com>
AuthorDate: Wed Jun 10 15:03:38 2015 -0300
Commit:     Moritz Heidkamp <moritz.heidkamp@bevuta.com>
CommitDate: Tue Jun 16 20:53:13 2015 +0200

    data-structures: fix substring-index[-ci] corner case ("" as 2nd arg)
    
    Fix regression introduced by 25db851b90260:
    
    $ ~/local/chicken-4.9.0.1/bin/csi -p '(substring-index "foo" "")'
    
    $ ~/local/chicken-4.10.0rc1/bin/csi -p '(substring-index "foo" "")'
    
    Error: (substring-index) out of range
    0
    0
    
            Call history:
    
            <syntax>          (substring-index "foo" "")
            <eval>    (substring-index "foo" "")    <--
    
    Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>

diff --git a/data-structures.scm b/data-structures.scm
index 5664d087..38857501 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -312,11 +312,14 @@
 	   (end (fx- wherelen whichlen)))
       (##sys#check-exact start loc)
       (if (and (fx>= start 0)
-	       (fx> wherelen start))
-	  (let loop ((istart start))
-	    (cond ((fx> istart end) #f)
-		  ((test istart whichlen) istart)
-		  (else (loop (fx+ istart 1)))))
+	       (fx>= wherelen start))
+	  (if (fx= whichlen 0)
+	      start
+	      (and (fx>= end 0)
+		   (let loop ((istart start))
+		     (cond ((fx> istart end) #f)
+			   ((test istart whichlen) istart)
+			   (else (loop (fx+ istart 1)))))))
 	  (##sys#error-hook (foreign-value "C_OUT_OF_RANGE_ERROR" int)
 			    loc
 			    start
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index b5768074..8e98ef6d 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -47,6 +47,12 @@
 (assert (not (substring-ci=? "foo\x00a" "foo\x00b" 1 1)))
 (assert (not (substring-index "o\x00bar" "foo\x00baz")))
 (assert (not (substring-index-ci "o\x00bar" "foo\x00baz")))
+(assert (= 0 (substring-index "" "")))
+(assert (= 1 (substring-index "" "a" 1)))
+(assert-error (substring-index "" "a" 2))
+(assert-error (substring-index "a" "b" 2))
+(assert (not (substring-index "a" "b" 1)))
+(assert (not (substring-index "ab" "")))
 (assert (= 0 (string-compare3 "foo\x00a" "foo\x00a")))
 (assert (> 0 (string-compare3 "foo\x00a" "foo\x00b")))
 (assert (< 0 (string-compare3 "foo\x00b" "foo\x00a")))
Trap