Attachment "TIP-241v4.diff" to
ticket [1152746fff]
added by
mistachkin
2005-03-02 13:53:53.
Index: doc/lsearch.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/lsearch.n,v
retrieving revision 1.22
diff -u -r1.22 lsearch.n
--- doc/lsearch.n 5 Jan 2005 16:38:54 -0000 1.22
+++ doc/lsearch.n 2 Mar 2005 06:36:12 -0000
@@ -93,6 +93,13 @@
.TP
\fB\-integer\fR
The list elements are to be compared as integers.
+.VS 8.5
+.TP
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner. Has no
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
+\fB\-real\fR options.
+.VE 8.5
.TP
\fB\-real\fR
The list elements are to be compared as floating-point values.
Index: doc/lsort.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/lsort.n,v
retrieving revision 1.18
diff -u -r1.18 lsort.n
--- doc/lsort.n 27 Oct 2004 12:53:22 -0000 1.18
+++ doc/lsort.n 2 Mar 2005 06:36:12 -0000
@@ -10,7 +10,7 @@
'\" RCS: @(#) $Id: lsort.n,v 1.17 2004/10/14 17:20:11 dkf Exp $
'\"
.so man.macros
-.TH lsort n 8.3 Tcl "Tcl Built-In Commands"
+.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -107,6 +107,13 @@
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
+.VS 8.5
+.TP 20
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner. Has no
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
+\fB\-real\fR options.
+.VE 8.5
.TP 20
\fB\-unique\fR
If this option is specified, then only the last set of duplicate
Index: doc/switch.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/switch.n,v
retrieving revision 1.8
diff -u -r1.8 switch.n
--- doc/switch.n 27 Oct 2004 14:24:37 -0000 1.8
+++ doc/switch.n 2 Mar 2005 06:36:13 -0000
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id: switch.n,v 1.7 2004/04/22 22:36:22 dkf Exp $
'\"
.so man.macros
-.TH switch n 7.0 Tcl "Tcl Built-In Commands"
+.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -51,6 +51,9 @@
'\" Options defined by TIP#75
.VS 8.5
.TP 10
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner.
+.TP 10
\fB\-matchvar\fR \fIvarName\fR
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of matches
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.71
diff -u -r1.71 tclCmdIL.c
--- generic/tclCmdIL.c 14 Dec 2004 21:11:45 -0000 1.71
+++ generic/tclCmdIL.c 2 Mar 2005 06:36:23 -0000
@@ -35,6 +35,15 @@
} SortElement;
/*
+ * These function pointer types are used with the "lsearch" and "lsort"
+ * commands to facilitate the "-nocase" option.
+ */
+
+typedef int (*SortStrCmpFn_t) _ANSI_ARGS_((const char *, const char *));
+typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *,
+ size_t));
+
+/*
* The "lsort" command needs to pass certain information down to the
* function that compares two list elements, and the comparison function
* needs to pass success or failure information back up to the top-level
@@ -46,6 +55,8 @@
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_*
* values defined below */
+ SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
+ * ASCII mode). */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode
* is SORTMODE_COMMAND. Pre-initialized to
* hold base of command.*/
@@ -3096,7 +3107,7 @@
char *bytes, *patternBytes;
int i, match, mode, index, result, listc, length, elemLen;
int dataType, isIncreasing, lower, upper, patInt, objInt;
- int offset, allMatches, inlineReturn, negatedMatch, returnSubindices;
+ int offset, allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
@@ -3104,15 +3115,17 @@
static CONST char *options[] = {
"-all", "-ascii", "-decreasing", "-dictionary",
"-exact", "-glob", "-increasing", "-index",
- "-inline", "-integer", "-not", "-real",
- "-regexp", "-sorted", "-start", "-subindices",
+ "-inline", "-integer", "-nocase", "-not",
+ "-real", "-regexp", "-sorted", "-start",
+ "-subindices",
NULL
};
enum options {
LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
- LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL,
- LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START, LSEARCH_SUBINDICES
+ LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
+ LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
+ LSEARCH_SUBINDICES
};
enum datatypes {
ASCII, DICTIONARY, INTEGER, REAL
@@ -3120,6 +3133,8 @@
enum modes {
EXACT, GLOB, REGEXP, SORTED
};
+ SortStrCmpFn_t strCmpFn = strcmp;
+ SortMemCmpFn_t memCmpFn = memcmp;
mode = GLOB;
dataType = ASCII;
@@ -3131,6 +3146,7 @@
listPtr = NULL;
startPtr = NULL;
offset = 0;
+ noCase = 0;
sortInfo.compareCmdPtr = NULL;
sortInfo.isIncreasing = 0;
sortInfo.sortMode = 0;
@@ -3183,6 +3199,11 @@
case LSEARCH_INTEGER: /* -integer */
dataType = INTEGER;
break;
+ case LSEARCH_NOCASE: /* -nocase */
+ strCmpFn = strcasecmp;
+ memCmpFn = strncasecmp;
+ noCase = 1;
+ break;
case LSEARCH_NOT: /* -not */
negatedMatch = 1;
break;
@@ -3317,7 +3338,7 @@
* regexp rep before the list rep.
*/
regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
- TCL_REG_ADVANCED | TCL_REG_NOSUB);
+ TCL_REG_ADVANCED | TCL_REG_NOSUB | (noCase ? TCL_REG_NOCASE : 0));
if (regexp == NULL) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
@@ -3426,7 +3447,7 @@
switch ((enum datatypes) dataType) {
case ASCII:
bytes = TclGetString(itemPtr);
- match = strcmp(patternBytes, bytes);
+ match = strCmpFn(patternBytes, bytes);
break;
case DICTIONARY:
bytes = TclGetString(itemPtr);
@@ -3524,7 +3545,7 @@
case ASCII:
bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
if (length == elemLen) {
- match = (memcmp(bytes, patternBytes,
+ match = (memCmpFn(bytes, patternBytes,
(size_t) length) == 0);
}
break;
@@ -3564,7 +3585,7 @@
break;
case GLOB:
- match = Tcl_StringMatch(TclGetString(itemPtr), patternBytes);
+ match = Tcl_StringCaseMatch(TclGetString(itemPtr), patternBytes, noCase);
break;
case REGEXP:
match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
@@ -3766,12 +3787,12 @@
* comparison function */
static CONST char *switches[] = {
"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
- "-index", "-indices", "-integer", "-real", "-unique", (char *) NULL
+ "-index", "-indices", "-integer", "-nocase", "-real", "-unique", (char *) NULL
};
enum Lsort_Switches {
LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
- LSORT_REAL, LSORT_UNIQUE
+ LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE
};
if (objc < 2) {
@@ -3785,6 +3806,7 @@
sortInfo.isIncreasing = 1;
sortInfo.sortMode = SORTMODE_ASCII;
+ sortInfo.strCmpFn = strcmp;
sortInfo.indexv = NULL;
sortInfo.indexc = 0;
sortInfo.interp = interp;
@@ -3883,6 +3905,9 @@
case LSORT_INTEGER:
sortInfo.sortMode = SORTMODE_INTEGER;
break;
+ case LSORT_NOCASE:
+ sortInfo.strCmpFn = strcasecmp;
+ break;
case LSORT_REAL:
sortInfo.sortMode = SORTMODE_REAL;
break;
@@ -4157,7 +4182,7 @@
}
if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = strcmp(TclGetString(objPtr1), TclGetString(objPtr2));
+ order = infoPtr->strCmpFn(TclGetString(objPtr1), TclGetString(objPtr2));
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
order = DictionaryCompare(
TclGetString(objPtr1), TclGetString(objPtr2));
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.115
diff -u -r1.115 tclCmdMZ.c
--- generic/tclCmdMZ.c 21 Oct 2004 15:19:46 -0000 1.115
+++ generic/tclCmdMZ.c 2 Mar 2005 06:36:28 -0000
@@ -2501,23 +2501,26 @@
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, j, index, mode, result, splitObjs, numMatchesSaved;
+ int i, j, index, mode, result, splitObjs, numMatchesSaved, noCase;
char *pattern;
Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
Tcl_Obj *CONST *savedObjv = objv;
Tcl_RegExp regExpr = NULL;
static CONST char *options[] = {
- "-exact", "-glob", "-indexvar", "-matchvar", "-regexp", "--",
+ "-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp", "--",
NULL
};
enum options {
- OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_REGEXP, OPT_LAST
+ OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP, OPT_LAST
};
+ typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *));
+ strCmpFn_t strCmpFn = strcmp;
mode = OPT_EXACT;
indexVarObj = NULL;
matchVarObj = NULL;
numMatchesSaved = 0;
+ noCase = 0;
for (i = 1; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
@@ -2556,6 +2559,9 @@
}
matchVarObj = objv[i];
numMatchesSaved = -1;
+ } else if (index == OPT_NOCASE) {
+ strCmpFn = strcasecmp;
+ noCase = 1;
} else {
mode = index;
}
@@ -2694,18 +2700,18 @@
} else {
switch (mode) {
case OPT_EXACT:
- if (strcmp(TclGetString(stringObj), pattern) == 0) {
+ if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
goto matchFound;
}
break;
case OPT_GLOB:
- if (Tcl_StringMatch(TclGetString(stringObj), pattern)) {
+ if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern, noCase)) {
goto matchFound;
}
break;
case OPT_REGEXP:
regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
- TCL_REG_ADVANCED);
+ TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
if (regExpr == NULL) {
return TCL_ERROR;
} else {
Index: tests/cmdIL.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdIL.test,v
retrieving revision 1.23
diff -u -r1.23 cmdIL.test
--- tests/cmdIL.test 14 Oct 2004 17:20:11 -0000 1.23
+++ tests/cmdIL.test 2 Mar 2005 06:36:35 -0000
@@ -23,7 +23,7 @@
} {1 {wrong # args: should be "lsort ?options? list"}}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique}}
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
@@ -383,6 +383,12 @@
test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} {
lsort -dictionary [list AA ! c CC `]
} [list ! ` AA c CC]
+test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
+ lsort -ascii -nocase {d e c b a d35 d300 100 20}
+} {100 20 a b c d d300 d35 e}
+test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
+ lsort -ascii -nocase {d E c B a D35 d300 100 20}
+} {100 20 a B c d d300 D35 E}
test cmdIL-5.1 {lsort with list style index} {
lsort -ascii -decreasing -index {0 1} {
Index: tests/lsearch.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/lsearch.test,v
retrieving revision 1.13
diff -u -r1.13 lsearch.test
--- tests/lsearch.test 15 Oct 2003 13:15:45 -0000 1.13
+++ tests/lsearch.test 2 Mar 2005 06:36:37 -0000
@@ -61,7 +61,25 @@
} 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, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "-glib": must be -all, -ascii, -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
+test lsearch-2.12 {search modes with -nocase} {
+ lsearch -glob -nocase {a b c A B C} A*
+} 0
+test lsearch-2.13 {search modes with -nocase} {
+ lsearch -regexp -nocase {a b c A B C} ^A\$
+} 0
+test lsearch-2.14 {search modes without -nocase} {
+ lsearch -exact {a b c A B C} A
+} 3
+test lsearch-2.15 {search modes without -nocase} {
+ lsearch -glob {a b c A B C} A*
+} 3
+test lsearch-2.16 {search modes without -nocase} {
+ lsearch -regexp {a b c A B C} ^A\$
+} 3
test lsearch-3.1 {lsearch errors} {
list [catch lsearch msg] $msg
@@ -71,10 +89,10 @@
} {1 {wrong # args: should be "lsearch ?options? 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, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -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, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -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}}
@@ -320,6 +338,15 @@
test lsearch-13.2 {search for all matches} {
lsearch -all {a b a c a d} a
} {0 2 4}
+test lsearch-13.3 {search for all matches with -nocase} {
+ lsearch -all -exact -nocase {a b c A B C} A
+} {0 3}
+test lsearch-13.4 {search for all matches with -nocase} {
+ lsearch -all -glob -nocase {a b c A B C} A*
+} {0 3}
+test lsearch-13.5 {search for all matches with -nocase} {
+ lsearch -all -regexp -nocase {a b c A B C} ^A\$
+} {0 3}
test lsearch-14.1 {combinations: -all and -inline} {
lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
Index: tests/switch.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/switch.test,v
retrieving revision 1.10
diff -u -r1.10 switch.test
--- tests/switch.test 14 Dec 2003 18:32:36 -0000 1.10
+++ tests/switch.test 2 Mar 2005 06:36:39 -0000
@@ -39,6 +39,18 @@
test switch-1.7 {simple patterns} {
switch x a {format 1} default {format 2} c {format 3} default {format 4}
} 4
+test switch-1.8 {simple patterns with -nocase} {
+ switch -nocase b a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.9 {simple patterns with -nocase} {
+ switch -nocase B a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.10 {simple patterns with -nocase} {
+ switch -nocase b a {format 1} B {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.11 {simple patterns with -nocase} {
+ switch -nocase x a {format 1} default {format 2} c {format 3} default {format 4}
+} 4
test switch-2.1 {single-argument form for pattern/command pairs} {
switch b {
@@ -89,7 +101,43 @@
} exact
test switch-3.6 {-exact vs. -glob vs. -regexp} {
list [catch {switch -foo a b c} msg] $msg
-} {1 {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -regexp, or --}}
+} {1 {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}}
+test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} {
+ switch -exact -nocase aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} exact
+test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} {
+ switch -regexp -nocase aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} regexp
+test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} {
+ switch -glob -nocase aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} glob
+test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} {
+ switch -nocase aaaab {^a*b$} {concat regexp} *b {concat glob} \
+ aaaab {concat exact} default {concat none}
+} exact
+test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} {
+ switch -nocase -- -glob {
+ ^g.*b$ {concat regexp}
+ -* {concat glob}
+ -glob {concat exact}
+ default {concat none}
+ }
+} exact
test switch-4.1 {error in executed command} {
list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
Index: win/tclWinPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPort.h,v
retrieving revision 1.43
diff -u -r1.43 tclWinPort.h
--- win/tclWinPort.h 3 Nov 2004 21:07:01 -0000 1.43
+++ win/tclWinPort.h 2 Mar 2005 06:36:40 -0000
@@ -45,6 +45,13 @@
#include <string.h>
/*
+ * These string functions are not defined with the same names on Windows.
+ */
+
+#define strcasecmp stricmp
+#define strncasecmp strnicmp
+
+/*
* Need to block out these includes for building extensions with MetroWerks
* compiler for Win32.
*/
