Another attempt at fixing #1835, hopefully this time for good.
Adds a +1 to each paramter string's length, to permit starting to compare at
end of string, and corresponding tests.
The errors I experienced in csi were caused by a bug in the breadline egg. Will
share a patch with wasamasa.
siiky
From 83ca38e42d538836217b2893a2afc713ce362e1f Mon Sep 17 00:00:00 2001
From: siiky <github-si...@net-c.cat>
Date: Sat, 27 Apr 2024 01:41:18 +0100
Subject: [PATCH] =?UTF-8?q?Fix=20bounds=20check=20in=20substring[-ci]=3D?=
=?UTF-8?q?=3F?=
It should be permitted to start comparing at the end of a string.
---
data-structures.scm | 8 ++++----
tests/data-structures-tests.scm | 8 ++++++++
2 files changed, 12 insertions(+), 4 deletions(-)
diff --git a/data-structures.scm b/data-structures.scm
index ad09d26b..1c3f063d 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -155,8 +155,8 @@
(define (##sys#substring=? s1 s2 start1 start2 n)
(##sys#check-string s1 'substring=?)
(##sys#check-string s2 'substring=?)
- (##sys#check-range start1 0 (##sys#size s1) 'substring=?)
- (##sys#check-range start2 0 (##sys#size s2) 'substring=?)
+ (##sys#check-range start1 0 (fx+ (##sys#size s1) 1) 'substring=?)
+ (##sys#check-range start2 0 (fx+ (##sys#size s2) 1) 'substring=?)
(let* ((maxlen (fxmin (fx- (##sys#size s1) start1)
(fx- (##sys#size s2) start2)))
(len (if n
@@ -170,8 +170,8 @@
(define (##sys#substring-ci=? s1 s2 start1 start2 n)
(##sys#check-string s1 'substring-ci=?)
(##sys#check-string s2 'substring-ci=?)
- (##sys#check-range start1 0 (##sys#size s1) 'substring-ci=?)
- (##sys#check-range start2 0 (##sys#size s2) 'substring-ci=?)
+ (##sys#check-range start1 0 (fx+ (##sys#size s1) 1) 'substring-ci=?)
+ (##sys#check-range start2 0 (fx+ (##sys#size s2) 1) 'substring-ci=?)
(let* ((maxlen (fxmin (fx- (##sys#size s1) start1)
(fx- (##sys#size s2) start2)))
(len (if n
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index eb779531..a81b87b6 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -46,6 +46,14 @@
(assert (= 2 (substring-index-ci "o\x00bar" "foo\x00BAR")))
(assert (not (substring=? "foo\x00a" "foo\x00b" 1 1)))
(assert (not (substring-ci=? "foo\x00a" "foo\x00b" 1 1)))
+(assert (substring=? "" "" 0 0 0))
+(assert (substring-ci=? "" "" 0 0 0))
+(assert (substring=? "" "abc"))
+(assert (substring-ci=? "" "abc"))
+(assert (substring=? "abc" ""))
+(assert (substring-ci=? "abc" ""))
+(assert-error (substring=? "" "" 0 0 1))
+(assert-error (substring-ci=? "" "" 0 0 1))
(assert (substring=? "foo" "foo" 0 0 3))
(assert (substring-ci=? "foo" "foo" 0 0 3))
(assert (not (substring-index "o\x00bar" "foo\x00baz")))
--
2.43.0
