Attachment "tcl-8.6.4-string-first.patch" to
ticket [d2323d6c28]
added by
anonymous
2016-02-25 14:35:22.
--- ./generic/tclCmdMZ.c.orig 2016-02-25 10:18:33.831012950 +0100
+++ ./generic/tclCmdMZ.c 2016-02-25 11:12:05.782012730 +0100
@@ -1181,11 +1181,11 @@
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *needleStr, *haystackStr;
- int match, start, needleLen, haystackLen;
+ int match, start, last, needleLen, haystackLen;
- if (objc < 3 || objc > 4) {
+ if (objc < 3 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv,
- "needleString haystackString ?startIndex?");
+ "needleString haystackString ?startIndex? ?lastIndex?");
return TCL_ERROR;
}
@@ -1195,12 +1195,32 @@
match = -1;
start = 0;
+ needleLen = -1;
haystackLen = -1;
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+ last = haystackLen-needleLen; /* 0-based index of last possible match position */
- if (objc == 4) {
+ if (objc >= 4) {
+ if (objc >= 5) {
+ /*
+ * If a lastIndex is specified, we will stop checking for a match
+ * after this position.
+ */
+
+ if (TclGetIntForIndexM(interp, objv[4], haystackLen-1,
+ &last) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ /*
+ * Will check for (start <= last) after reading startIndex.
+ */
+ if (last > haystackLen-needleLen) {
+ last = haystackLen-needleLen;
+ }
+ }
/*
* If a startIndex is specified, we will need to fast forward to that
* point in the string before we think about a match.
@@ -1218,9 +1238,8 @@
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
- if (start >= haystackLen) {
- goto str_first_done;
- } else if (start > 0) {
+ /* Moved check for (start <= last) to the global branch below. */
+ if (start > 0) {
haystackStr += start;
haystackLen -= start;
} else if (start < 0) {
@@ -1235,13 +1254,14 @@
/*
* If the length of the needle is more than the length of the haystack, it
* cannot be contained in there so we can avoid searching. [Bug 2960021]
+ * This check is now included in (start <= last) with (last = haystackLen-needleLen).
*/
- if (needleLen > 0 && needleLen <= haystackLen) {
+ if (needleLen > 0 && start <= last) {
register Tcl_UniChar *p, *end;
- end = haystackStr + haystackLen - needleLen + 1;
- for (p = haystackStr; p < end; p++) {
+ end = haystackStr + last - start;
+ for (p = haystackStr; p <= end; p++) {
/*
* Scan forward to find the first character.
*/
@@ -1259,11 +1279,10 @@
* number of characters before the match.
*/
- if ((match != -1) && (objc == 4)) {
+ if (match != -1) {
match += start;
}
- str_first_done:
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
return TCL_OK;
}
--- ./tests/stringComp.test.orig 2016-02-25 14:03:53.657011006 +0100
+++ ./tests/stringComp.test 2016-02-25 14:18:00.405010804 +0100
@@ -225,59 +225,91 @@
test stringComp-4.1 {string first, too few args} {
proc foo {} {string first a}
list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex? ?lastIndex?"}}
test stringComp-4.2 {string first, bad args} {
proc foo {} {string first a b c}
list [catch {foo} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
-test stringComp-4.3 {string first, too many args} {
+test stringComp-4.3 {string first, bad args} {
proc foo {} {string first a b 5 d}
list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test stringComp-4.4 {string first} {
+} {1 {bad index "d": must be integer?[+-]integer? or end?[+-]integer?}}
+test stringComp-4.4 {string first, too many args} {
+ proc foo {} {string first a b 5 7 e}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex? ?lastIndex?"}}
+test stringComp-4.5 {string first} {
proc foo {} {string first bq abcdefgbcefgbqrs}
foo
} 12
-test stringComp-4.5 {string first} {
+test stringComp-4.6 {string first} {
proc foo {} {string fir bcd abcdefgbcefgbqrs}
foo
} 1
-test stringComp-4.6 {string first} {
+test stringComp-4.7 {string first} {
proc foo {} {string f b abcdefgbcefgbqrs}
foo
} 1
-test stringComp-4.7 {string first} {
+test stringComp-4.8 {string first} {
proc foo {} {string first xxx x123xx345xxx789xxx012}
foo
} 9
-test stringComp-4.8 {string first} {
+test stringComp-4.9 {string first} {
proc foo {} {string first "" x123xx345xxx789xxx012}
foo
} -1
-test stringComp-4.9 {string first, unicode} {
+test stringComp-4.10 {string first, unicode} {
proc foo {} {string first x abc\u7266x}
foo
} 4
-test stringComp-4.10 {string first, unicode} {
+test stringComp-4.11 {string first, unicode} {
proc foo {} {string first \u7266 abc\u7266x}
foo
} 3
-test stringComp-4.11 {string first, start index} {
+test stringComp-4.12 {string first, start index} {
proc foo {} {string first \u7266 abc\u7266x 3}
foo
} 3
-test stringComp-4.12 {string first, start index} {
+test stringComp-4.13 {string first, start index} {
proc foo {} {string first \u7266 abc\u7266x 4}
foo
} -1
-test stringComp-4.13 {string first, start index} {
+test stringComp-4.14 {string first, start index} {
proc foo {} {string first \u7266 abc\u7266x end-2}
foo
} 3
-test stringComp-4.14 {string first, negative start index} {
+test stringComp-4.15 {string first, negative start index} {
proc foo {} {string first b abc -1}
foo
} 1
+test stringComp-4.16 {string first, last index} {
+ proc foo {} {string first b abc 0 1}
+ foo
+} 1
+test stringComp-4.17 {string first, last index} {
+ proc foo {} {string first b abc 0 0}
+ foo
+} -1
+test stringComp-4.18 {string first, last index} {
+ proc foo {} {string first b abc 1 0}
+ foo
+} -1
+test stringComp-4.19 {string first, last index} {
+ proc foo {} {string first abcd abcabcabcd 0 6}
+ foo
+} 6
+test stringComp-4.20 {string first, last index} {
+ proc foo {} {string first abcd abcabcabcd 6 42}
+ foo
+} 6
+test stringComp-4.21 {string first, last index} {
+ proc foo {} {string first abcd abcabcabcd 5 5}
+ foo
+} -1
+test stringComp-4.22 {string first, last index} {
+ proc foo {} {string first abcd abcabcabcd 6 6}
+ foo
+} 6
test stringComp-5.1 {string index} {
proc foo {} {string index}
--- ./tests/string.test.orig 2016-02-25 14:40:54.042010701 +0100
+++ ./tests/string.test 2016-02-25 14:41:27.077010828 +0100
@@ -175,49 +175,8 @@
string equal -length 2 abc abde
} 1
-test string-4.1 {string first, too few args} {
- list [catch {string first a} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test string-4.2 {string first, bad args} {
- list [catch {string first a b c} msg] $msg
-} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-4.3 {string first, too many args} {
- list [catch {string first a b 5 d} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test string-4.4 {string first} {
- string first bq abcdefgbcefgbqrs
-} 12
-test string-4.5 {string first} {
- string fir bcd abcdefgbcefgbqrs
-} 1
-test string-4.6 {string first} {
- string f b abcdefgbcefgbqrs
-} 1
-test string-4.7 {string first} {
- string first xxx x123xx345xxx789xxx012
-} 9
-test string-4.8 {string first} {
- string first "" x123xx345xxx789xxx012
-} -1
-test string-4.9 {string first, unicode} {
- string first x abc\u7266x
-} 4
-test string-4.10 {string first, unicode} {
- string first \u7266 abc\u7266x
-} 3
-test string-4.11 {string first, start index} {
- string first \u7266 abc\u7266x 3
-} 3
-test string-4.12 {string first, start index} {
- string first \u7266 abc\u7266x 4
-} -1
-test string-4.13 {string first, start index} {
- string first \u7266 abc\u7266x end-2
-} 3
-test string-4.14 {string first, negative start index} {
- string first b abc -1
-} 1
-test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
+# removed tests that are duplicated in stringComp.test
+test string-4.1 {string first, ability to two-byte encoded utf-8 chars} {
# Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
# strings was incorrect, leading to an index returned by [string first]
# which pointed past the end of the string.
