Attachment "tip313.patch" to
ticket [1894241fff]
added by
pspjuth
2008-09-20 06:07:51.
diff -Nur -x .git tclmaster/doc/lsearch.n tcl/doc/lsearch.n
--- tclmaster/doc/lsearch.n 2008-08-06 20:40:46.000000000 +0200
+++ tcl/doc/lsearch.n 2008-09-20 00:55:40.000000000 +0200
@@ -10,7 +10,7 @@
'\" RCS: @(#) $Id: lsearch.n,v 1.35 2008/06/29 22:28:24 dkf Exp $
'\"
.so man.macros
-.TH lsearch n 8.5 Tcl "Tcl Built-In Commands"
+.TH lsearch n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -134,6 +134,17 @@
.
The list elements are sorted in increasing order. This option is only
meaningful when used with \fB\-sorted\fR.
+.VS 8.6
+.TP
+\fB\-bisect\fR
+Inexact search when the list elements are in sorted order. For an increasing
+list the last index where the element is less than or equal to the pattern
+is returned. For a decreasing list the last index where the element is greater
+than or equal to the pattern is returned. If the pattern is before the first
+element or the list is empty, -1 is returned.
+This option implies \fB\-sorted\fR and cannot be used with either \fB\-all\fR
+or \fB\-not\fR.
+.VE 8.6
.SS "NESTED LIST OPTIONS"
.PP
These options are used to search lists of lists. They may be used
diff -Nur -x .git tclmaster/generic/tclCmdIL.c tcl/generic/tclCmdIL.c
--- tclmaster/generic/tclCmdIL.c 2008-08-27 19:36:50.000000000 +0200
+++ tcl/generic/tclCmdIL.c 2008-09-20 00:55:40.000000000 +0200
@@ -2732,7 +2732,7 @@
Tcl_Obj *const objv[]) /* Argument values. */
{
char *bytes, *patternBytes;
- int i, match, mode, index, result, listc, length, elemLen;
+ int i, match, index, result, listc, length, elemLen, bisect;
int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
@@ -2741,14 +2741,14 @@
SortStrCmpFn_t strCmpFn = strcmp;
Tcl_RegExp regexp = NULL;
static const char *options[] = {
- "-all", "-ascii", "-decreasing", "-dictionary",
+ "-all", "-ascii", "-bisect", "-decreasing", "-dictionary",
"-exact", "-glob", "-increasing", "-index",
"-inline", "-integer", "-nocase", "-not",
"-real", "-regexp", "-sorted", "-start",
"-subindices", NULL
};
enum options {
- LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
+ LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
@@ -2760,6 +2760,7 @@
enum modes {
EXACT, GLOB, REGEXP, SORTED
};
+ enum modes mode;
mode = GLOB;
dataType = ASCII;
@@ -2768,6 +2769,7 @@
inlineReturn = 0;
returnSubindices = 0;
negatedMatch = 0;
+ bisect = 0;
listPtr = NULL;
startPtr = NULL;
offset = 0;
@@ -2803,6 +2805,10 @@
case LSEARCH_ASCII: /* -ascii */
dataType = ASCII;
break;
+ case LSEARCH_BISECT: /* -bisect */
+ mode = SORTED;
+ bisect = 1;
+ break;
case LSEARCH_DECREASING: /* -decreasing */
isIncreasing = 0;
sortInfo.isIncreasing = 0;
@@ -2954,7 +2960,13 @@
return TCL_ERROR;
}
- if ((enum modes) mode == REGEXP) {
+ if (bisect && (allMatches || negatedMatch)) {
+ Tcl_AppendResult(interp,
+ "-bisect is not compatible with -all or -not", NULL);
+ return TCL_ERROR;
+ }
+
+ if (mode == REGEXP) {
/*
* We can shimmer regexp/list if listv[i] == pattern, so get the
* regexp rep before the list rep. First time round, omit the interp
@@ -3040,7 +3052,7 @@
patObj = objv[objc - 1];
patternBytes = NULL;
- if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
+ if (mode == EXACT || mode == SORTED) {
switch ((enum datatypes) dataType) {
case ASCII:
case DICTIONARY:
@@ -3091,7 +3103,7 @@
index = -1;
match = 0;
- if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
+ if (mode == SORTED && !allMatches && !negatedMatch) {
/*
* If the data is sorted, we can do a more intelligent search. Note
* that there is no point in being smart when -all was specified; in
@@ -3169,10 +3181,16 @@
* variation means that a search always makes log n
* comparisons (normal binary search might "get lucky" with an
* early comparison).
+ *
+ * In bisect mode though, we want the last of equals.
*/
index = i;
- upper = i;
+ if (bisect) {
+ lower = i;
+ } else {
+ upper = i;
+ }
} else if (match > 0) {
if (isIncreasing) {
lower = i;
@@ -3187,7 +3205,9 @@
}
}
}
-
+ if (bisect && index < 0) {
+ index = lower;
+ }
} else {
/*
* We need to do a linear search, because (at least one) of:
@@ -3215,8 +3235,8 @@
} else {
itemPtr = listv[i];
}
-
- switch ((enum modes) mode) {
+
+ switch (mode) {
case SORTED:
case EXACT:
switch ((enum datatypes) dataType) {
diff -Nur -x .git tclmaster/tests/lsearch.test tcl/tests/lsearch.test
--- tclmaster/tests/lsearch.test 2008-08-06 20:40:46.000000000 +0200
+++ tcl/tests/lsearch.test 2008-09-20 00:55:40.000000000 +0200
@@ -61,7 +61,7 @@
} 1
test lsearch-2.10 {search modes} {
list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-2.11 {search modes with -nocase} {
lsearch -exact -nocase {a b c A B C} A
} 0
@@ -89,10 +89,10 @@
} {1 {wrong # args: should be "lsearch ?-option value ...? list pattern"}}
test lsearch-3.3 {lsearch errors} {
list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-3.4 {lsearch errors} {
list [catch {lsearch a b c d} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-3.5 {lsearch errors} {
list [catch {lsearch "\{" b} msg] $msg
} {1 {unmatched open brace in list}}
@@ -472,6 +472,47 @@
lsearch -exact -real $x $x
} 0
+test lsearch-22.1 {lsearch -bisect} -body {
+ set res {}
+ foreach i {0 1 5 6 7 8 15 16} {
+ lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i]
+ }
+ set res
+} -result {-1 0 2 2 3 3 5 5}
+
+test lsearch-22.2 {lsearch -bisect, last of equals} -body {
+ set res {}
+ foreach i {0 1 2 3} {
+ lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i]
+ }
+ set res
+} -result {1 4 7 10}
+test lsearch-22.3 {lsearch -bisect decreasing order} -body {
+ set res {}
+ foreach i {0 1 5 6 7 8 15 16} {
+ lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i]
+ }
+ set res
+} -result {5 5 3 2 2 1 0 -1}
+
+test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -body {
+ set res {}
+ foreach i {0 1 2 3} {
+ lappend res [lsearch -bisect -integer -decreasing \
+ {3 3 3 2 2 2 1 1 1 0 0} $i]
+ }
+ set res
+} -result {10 8 5 2}
+
+test lsearch-22.5 {lsearch -bisect, all equal} -body {
+ lsearch -bisect -integer {5 5 5 5} 5
+} -result {3}
+
+test lsearch-22.6 {lsearch -sorted, all equal} -body {
+ lsearch -sorted -integer {5 5 5 5} 5
+} -result {0}
+
+
# cleanup
catch {unset res}
catch {unset increasingIntegers}
