>From 2d0a23e8c84bc8b1c5f5dbc9f464866c0677c5ad Mon Sep 17 00:00:00 2001 From: Mario Domenech Goulart Date: Wed, 10 Jun 2015 15:03:38 -0300 Subject: [PATCH] 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: (substring-index "foo" "") (substring-index "foo" "") <-- --- data-structures.scm | 22 ++++++++++++---------- tests/data-structures-tests.scm | 2 ++ 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/data-structures.scm b/data-structures.scm index b67065e..0a457eb 100644 --- a/data-structures.scm +++ b/data-structures.scm @@ -311,16 +311,18 @@ (whichlen (##sys#size which)) (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))))) - (##sys#error-hook (foreign-value "C_OUT_OF_RANGE_ERROR" int) - loc - start - wherelen)))) + (if (fx= wherelen 0) + (and (fx= whichlen 0) 0) + (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))))) + (##sys#error-hook (foreign-value "C_OUT_OF_RANGE_ERROR" int) + loc + start + wherelen))))) (set! ##sys#substring-index (lambda (which where start) diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm index 51c25a9..d5e1d7f 100644 --- a/tests/data-structures-tests.scm +++ b/tests/data-structures-tests.scm @@ -47,6 +47,8 @@ (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 (not (substring-index "foo" ""))) (assert (= 0 (string-compare3 "foo\x00a" "foo\x00a"))) (assert (> 0 (string-compare3 "foo\x00a" "foo\x00b"))) (assert (< 0 (string-compare3 "foo\x00b" "foo\x00a"))) -- 1.7.10.4