diff options
author | dgp <dgp@users.sourceforge.net> | 2005-04-29 20:49:39 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-04-29 20:49:39 (GMT) |
commit | 8b1602650fa95940adc93df6e9c477d12de32664 (patch) | |
tree | 55c506247b96b5a5df5bcc7f1aeb3f66cbc3cdb8 | |
parent | 0ab970b22ad15d0f56a3d5a53461daedf8bfc5ef (diff) | |
download | tcl-8b1602650fa95940adc93df6e9c477d12de32664.zip tcl-8b1602650fa95940adc93df6e9c477d12de32664.tar.gz tcl-8b1602650fa95940adc93df6e9c477d12de32664.tar.bz2 |
TIP#176 IMPLEMENTATION [Patch 1165695]
* generic/tclUtil.c: Extended TclGetIntForIndex to recognize
index formats including end+integer and integer+/-integer.
* generic/tclCmdMZ.c: Extended the -start switch of [regexp]
and [regsub] to accept all index formats known by TclGetIntForIndex.
* doc/lindex.n: Updated docs to note new index formats.
* doc/linsert.n:
* doc/lrange.n:
* doc/lreplace.n:
* doc/lsearch.n:
* doc/lset.n:
* doc/lsort.n:
* doc/regexp.n:
* doc/regsub.n:
* doc/string.n:
* tests/cmdIL.test: Updated tests.
* tests/compile.test:
* tests/lindex.test:
* tests/linsert.test:
* tests/lrange.test:
* tests/lreplace.test:
* tests/lsearch.test:
* tests/lset.test:
* tests/regexp.test:
* tests/regexpComp.test:
* tests/string.test:
* tests/stringComp.test:
* tests/util.test:
-rw-r--r-- | ChangeLog | 35 | ||||
-rw-r--r-- | doc/lindex.n | 15 | ||||
-rw-r--r-- | doc/linsert.n | 18 | ||||
-rw-r--r-- | doc/lrange.n | 16 | ||||
-rw-r--r-- | doc/lreplace.n | 24 | ||||
-rw-r--r-- | doc/lsearch.n | 18 | ||||
-rwxr-xr-x | doc/lset.n | 16 | ||||
-rw-r--r-- | doc/lsort.n | 7 | ||||
-rw-r--r-- | doc/regexp.n | 15 | ||||
-rw-r--r-- | doc/regsub.n | 15 | ||||
-rw-r--r-- | doc/string.n | 32 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 63 | ||||
-rw-r--r-- | generic/tclUtil.c | 68 | ||||
-rw-r--r-- | tests/cmdIL.test | 4 | ||||
-rw-r--r-- | tests/compile.test | 8 | ||||
-rw-r--r-- | tests/lindex.test | 42 | ||||
-rw-r--r-- | tests/linsert.test | 4 | ||||
-rw-r--r-- | tests/lrange.test | 10 | ||||
-rw-r--r-- | tests/lreplace.test | 8 | ||||
-rw-r--r-- | tests/lsearch.test | 6 | ||||
-rw-r--r-- | tests/lset.test | 10 | ||||
-rw-r--r-- | tests/regexp.test | 32 | ||||
-rw-r--r-- | tests/regexpComp.test | 4 | ||||
-rw-r--r-- | tests/string.test | 38 | ||||
-rw-r--r-- | tests/stringComp.test | 10 | ||||
-rw-r--r-- | tests/util.test | 186 |
26 files changed, 549 insertions, 155 deletions
@@ -1,3 +1,38 @@ +2005-04-29 Don Porter <dgp@users.sourceforge.net> + + TIP#176 IMPLEMENTATION [Patch 1165695] + + * generic/tclUtil.c: Extended TclGetIntForIndex to recognize + index formats including end+integer and integer+/-integer. + + * generic/tclCmdMZ.c: Extended the -start switch of [regexp] + and [regsub] to accept all index formats known by TclGetIntForIndex. + + * doc/lindex.n: Updated docs to note new index formats. + * doc/linsert.n: + * doc/lrange.n: + * doc/lreplace.n: + * doc/lsearch.n: + * doc/lset.n: + * doc/lsort.n: + * doc/regexp.n: + * doc/regsub.n: + * doc/string.n: + + * tests/cmdIL.test: Updated tests. + * tests/compile.test: + * tests/lindex.test: + * tests/linsert.test: + * tests/lrange.test: + * tests/lreplace.test: + * tests/lsearch.test: + * tests/lset.test: + * tests/regexp.test: + * tests/regexpComp.test: + * tests/string.test: + * tests/stringComp.test: + * tests/util.test: + 2005-04-28 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test (7.1): Alternative fix for the diff --git a/doc/lindex.n b/doc/lindex.n index eba3cc3..d3b85b2 100644 --- a/doc/lindex.n +++ b/doc/lindex.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lindex.n,v 1.9 2005/04/06 20:55:23 dkf Exp $ +'\" RCS: @(#) $Id: lindex.n,v 1.10 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lindex n 8.4 Tcl "Tcl Built-In Commands" @@ -46,9 +46,11 @@ substitution and command substitution do not occur. If \fIindex\fR is negative or greater than or equal to the number of elements in \fIvalue\fR, then an empty string is returned. -If \fIindex\fR has the value \fBend\fR, it refers to the last element -in the list, and \fBend\-\fIinteger\fR refers to the last element in -the list minus the specified integer offset. +.VS 8.5 +The interpretation of each simple \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .PP If additional \fIindex\fR arguments are supplied, then each argument is used in turn to select an element from the previous indexing operation, @@ -79,7 +81,10 @@ lindex [lindex [lindex $a 1] 2] 3 .CE .SH "SEE ALSO" list(n), lappend(n), linsert(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, index, list diff --git a/doc/linsert.n b/doc/linsert.n index 1f4508c..d563650 100644 --- a/doc/linsert.n +++ b/doc/linsert.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: linsert.n,v 1.11 2005/04/06 20:55:23 dkf Exp $ +'\" RCS: @(#) $Id: linsert.n,v 1.12 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH linsert n 8.2 Tcl "Tcl Built-In Commands" @@ -24,11 +24,12 @@ This command produces a new list from \fIlist\fR by inserting all of the \fIelement\fR arguments just before the \fIindex\fR'th element of \fIlist\fR. Each \fIelement\fR argument will become a separate element of the new list. If \fIindex\fR is less than or equal to zero, then the new -elements are inserted at the beginning of the list. If \fIindex\fR has the -value \fBend\fR, or if it is greater than or equal to the number of -elements in the list, then the new elements are appended to the list. -\fBend\-\fIinteger\fR refers to the last element in the list minus the -specified integer offset. +elements are inserted at the beginning of the list. +.VS 8.5 +The interpretation of the \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE .SH EXAMPLE Putting some values into a list, first indexing from the start and then indexing from the end, and then chaining them together: @@ -42,7 +43,10 @@ set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .SH "SEE ALSO" list(n), lappend(n), lindex(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, insert, list diff --git a/doc/lrange.n b/doc/lrange.n index b502dba..974947a 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lrange.n,v 1.10 2005/04/06 20:55:23 dkf Exp $ +'\" RCS: @(#) $Id: lrange.n,v 1.11 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lrange n 7.4 Tcl "Tcl Built-In Commands" @@ -23,9 +23,12 @@ lrange \- Return one or more adjacent elements from a list \fIList\fR must be a valid Tcl list. This command will return a new list consisting of elements \fIfirst\fR through \fIlast\fR, inclusive. -\fIFirst\fR or \fIlast\fR -may be \fBend\fR (or any abbreviation of it) to refer to the last -element of the list. +.VS 8.5 +The index values \fIfirst\fR and \fIlast\fR are interpreted +the same as index values for the command \fBstring index\fR, +supporting simple index arithmetic and indices relative to the +end of the list. +.VE If \fIfirst\fR is less than zero, it is treated as if it were zero. If \fIlast\fR is greater than or equal to the number of elements in the list, then it is treated as if it were \fBend\fR. @@ -67,7 +70,10 @@ elements to .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lreplace(n), lsort(n) +lset(n), lreplace(n), lsort(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, list, range, sublist diff --git a/doc/lreplace.n b/doc/lreplace.n index ac6e434..f9f12e2 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lreplace.n,v 1.11 2005/04/06 20:55:23 dkf Exp $ +'\" RCS: @(#) $Id: lreplace.n,v 1.12 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" @@ -22,11 +22,17 @@ lreplace \- Replace elements in a list with new elements .PP \fBlreplace\fR returns a new list formed by replacing one or more elements of \fIlist\fR with the \fIelement\fR arguments. -\fIfirst\fR and \fIlast\fR specify the first and last index of the -range of elements to replace. 0 refers to the first element of the -list, and \fBend\fR (or any abbreviation of it) may be used to refer -to the last element of the list. If \fIlist\fR is empty, then -\fIfirst\fR and \fIlast\fR are ignored. +.VS 8.5 +\fIfirst\fR and \fIlast\fR are index values specifying the first and +last elements of the range to replace. +The index values \fIfirst\fR and \fIlast\fR are interpreted +the same as index values for the command \fBstring index\fR, +supporting simple index arithmetic and indices relative to the +end of the list. +0 refers to the first element of the +list, and \fBend\fR refers to the last element of the list. +If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored. +.VE If \fIfirst\fR is less than zero, it is considered to refer to the first element of the list. For non-empty lists, the element indicated @@ -66,7 +72,11 @@ a b c d .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lrange(n), lsort(n) +lset(n), lrange(n), lsort(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS element, list, replace diff --git a/doc/lsearch.n b/doc/lsearch.n index d456181..ffac227 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lsearch.n,v 1.22 2005/01/05 16:38:54 dkf Exp $ +'\" RCS: @(#) $Id: lsearch.n,v 1.23 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lsearch n 8.5 Tcl "Tcl Built-In Commands" @@ -70,10 +70,12 @@ This negates the sense of the match, returning the index of the first non-matching value in the list. .TP \fB\-start\fR\0\fIindex\fR -The list is searched starting at position \fIindex\fR. If \fIindex\fR -has the value \fBend\fR, it refers to the last element in the list, -and \fBend\-\fIinteger\fR refers to the last element in the list minus -the specified integer offset. +The list is searched starting at position \fIindex\fR. +.VS 8.5 +The interpretation of the \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .SS "CONTENTS DESCRIPTION OPTIONS" These options describe how to interpret the items in the list being searched. They are only meaningful when used with the \fB\-exact\fR @@ -166,7 +168,11 @@ It is also possible to search inside elements: .SH "SEE ALSO" foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS list, match, pattern, regular expression, search, string @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lset.n,v 1.7 2003/12/01 21:27:14 msofer Exp $ +'\" RCS: @(#) $Id: lset.n,v 1.8 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lset n 8.4 Tcl "Tcl Built-In Commands" @@ -52,9 +52,11 @@ command. If \fIindex\fR is negative or greater than or equal to the number of elements in \fI$varName\fR, then an error occurs. .PP -If \fIindex\fR has the value \fBend\fR, it refers to the last element -in the list, and \fBend\-\fIinteger\fR refers to the last element in -the list minus the specified integer offset. +.VS 8.5 +The interpretation of each simple \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .PP If additional \fIindex\fR arguments are supplied, then each argument is used in turn to address an element within a sublist designated @@ -107,7 +109,11 @@ lset x {1 1 0} j => {{a b} {c d}} {{e f} {j h}} .CE .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lsort(n), lrange(n), lreplace(n) +lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS element, index, list, replace, set diff --git a/doc/lsort.n b/doc/lsort.n index ae7d177..f1b29d4 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lsort.n,v 1.18 2004/10/27 12:53:22 dkf Exp $ +'\" RCS: @(#) $Id: lsort.n,v 1.19 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH lsort n 8.3 Tcl "Tcl Built-In Commands" @@ -78,10 +78,7 @@ sublists, \fBlsort\fR will extract the \fIindexList\fR'th element from each sublist .VS 8.5 (as if the overall element and the \fIindexList\fR were passed to -\fBlindex\fR) and sort based on the given element. The keyword -\fBend\fP is allowed for each element of the \fIindexList\fR to sort -on the last sublist element, and \fBend-\fIindex\fR sorts on a sublist -element offset from the end. +\fBlindex\fR) and sort based on the given element. .VE 8.5 For example, .RS diff --git a/doc/regexp.n b/doc/regexp.n index 7fece66..9567824 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: regexp.n,v 1.17 2005/04/06 20:55:23 dkf Exp $ +'\" RCS: @(#) $Id: regexp.n,v 1.18 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH regexp n 8.3 Tcl "Tcl Built-In Commands" @@ -107,7 +107,12 @@ regular expression. Examples are: .TP 15 \fB\-start\fR \fIindex\fR Specifies a character index offset into the string to start -matching the regular expression at. When using this switch, `^' +matching the regular expression at. +.VS 8.5 +The \fIindex\fR value is interpreted in the same manner +as the \fIindex\fR argument to \fBstring index\fR. +.VE 8.5 +When using this switch, `^' will not match the beginning of the line, and \\A will still match the start of the string at \fIindex\fR. If \fB\-indices\fR is specified, the indices will be indexed starting from the @@ -153,7 +158,11 @@ characters) in a string: .CE .SH "SEE ALSO" -re_syntax(n), regsub(n) +re_syntax(n), regsub(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS match, regular expression, string diff --git a/doc/regsub.n b/doc/regsub.n index 43b940f..259f2a5 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: regsub.n,v 1.13 2005/04/06 20:55:24 dkf Exp $ +'\" RCS: @(#) $Id: regsub.n,v 1.14 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH regsub n 8.3 Tcl "Tcl Built-In Commands" @@ -92,7 +92,12 @@ by \fIsubSpec\fR use the original unconverted form of \fIstring\fR. .TP 10 \fB\-start\fR \fIindex\fR Specifies a character index offset into the string to start -matching the regular expression at. When using this switch, `^' +matching the regular expression at. +.VS 8.5 +The \fIindex\fR value is interpreted in the same manner +as the \fIindex\fR argument to \fBstring index\fR. +.VE 8.5 +When using this switch, `^' will not match the beginning of the line, and \\A will still match the start of the string at \fIindex\fR. \fIindex\fR will be constrained to the bounds of the input string. @@ -134,7 +139,11 @@ set quoted [subst [\fBregsub\fR -all $RE $string $substitution]] .CE .SH "SEE ALSO" -regexp(n), re_syntax(n), subst(n) +regexp(n), re_syntax(n), subst(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS match, pattern, regular expression, substitute diff --git a/doc/string.n b/doc/string.n index 7d46ccb..3fe9678 100644 --- a/doc/string.n +++ b/doc/string.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: string.n,v 1.26 2005/03/07 21:38:10 dkf Exp $ +'\" RCS: @(#) $Id: string.n,v 1.27 2005/04/29 20:49:43 dgp Exp $ '\" .so man.macros .TH string n 8.1 Tcl "Tcl Built-In Commands" @@ -72,18 +72,38 @@ will return \fB\-1\fR. Returns the \fIcharIndex\fR'th character of the \fIstring\fR argument. A \fIcharIndex\fR of 0 corresponds to the first character of the string. \fIcharIndex\fR may be specified as follows: +.VS 8.5 .RS .IP \fIinteger\fR 10 -The char specified at this integral index. +For any index value that passes \fBstring is integer -strict\fR, +the char specified at this integral index +(e.g. \fB2\fR would refer to the "c" in "abcd"). .IP \fBend\fR 10 -The last char of the string. -.IP \fBend\-\fIinteger\fR 10 -The last char of the string minus the specified integer offset +The last char of the string +(e.g. \fBend\fR would refer to the "d" in "abcd"). +.IP \fBend\-\fIN\fR 10 +The last char of the string minus the specified integer offset \fIN\fR (e.g. \fBend\-1\fR would refer to the "c" in "abcd"). +.IP \fBend\+\fIN\fR 10 +The last char of the string plus the specified integer offset \fIN\fR +(e.g. \fBend\+\-1\fR would refer to the "c" in "abcd"). +.IP \fIM\fR\+\fIN\fR 10 +The char specified at the integral index that is the sum of +integer values \fIM\fR and \fIN\fR +(e.g. \fB1\+1\fR would refer to the "c" in "abcd"). +.IP \fIM\fR\-\fIN\fR 10 +The char specified at the integral index that is the difference of +integer values \fIM\fR and \fIN\fR +(e.g. \fB2\-1\fR would refer to the "b" in "abcd"). +.PP +In the specifications above, the integer value \fIM\fR contains no +trailing whitespace and the integer value \fIN\fR contains no +leading whitespace. .PP If \fIcharIndex\fR is less than 0 or greater than or equal to the -length of the string then an empty string is returned. +length of the string then this command returns an empty string. .RE +.VE .TP \fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR Returns 1 if \fIstring\fR is a valid member of the specified character diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e85e0ea..18da3f4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.116 2005/04/08 10:42:51 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.117 2005/04/29 20:49:43 dgp Exp $ */ #include "tclInt.h" @@ -90,7 +90,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; Tcl_RegExp regExpr; - Tcl_Obj *objPtr, *resultPtr = NULL; + Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static CONST char *options[] = { "-all", "-about", "-indices", "-inline", @@ -121,7 +121,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGEXP_ALL: { @@ -161,15 +161,18 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_START: { + int temp; if (++i >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[i], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[i]; + Tcl_IncrRefCount(startIndex); break; } case REGEXP_LAST: { @@ -183,7 +186,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); - return TCL_ERROR; + goto optionError; } objc -= i; objv += i; @@ -194,7 +197,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) */ Tcl_AppendResult(interp, "regexp match variables not allowed", " when using -inline", (char *) NULL); - return TCL_ERROR; + goto optionError; } /* @@ -203,6 +206,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } return TCL_ERROR; } return TCL_OK; @@ -216,6 +223,14 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); + if (startIndex) { + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; @@ -426,7 +441,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; - Tcl_Obj *resultPtr, *subPtr, *objPtr; + Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static CONST char *options[] = { @@ -455,7 +470,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGSUB_ALL: { @@ -483,15 +498,18 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) break; } case REGSUB_START: { + int temp; if (++idx >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[idx], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[idx]; + Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: { @@ -504,12 +522,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string subSpec ?varName?"); - return TCL_ERROR; +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + return TCL_ERROR; } objc -= idx; objv += idx; + if (startIndex) { + int stringLength = Tcl_GetCharLength(objv[1]); + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + if (all && (offset == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 16cee4b..1541216 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.55 2005/04/12 20:28:48 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.56 2005/04/29 20:49:44 dgp Exp $ */ #include "tclInt.h" @@ -2269,15 +2269,14 @@ TclLooksLikeInt(bytes, length) * * This procedure returns an integer corresponding to the list index * held in a Tcl object. The Tcl object's value is expected to be - * either an integer or a string of the form "end([+-]integer)?". + * in the format integer([+-]integer)? or the format end([+-]integer)?. * * Results: * The return value is normally TCL_OK, which means that the index was * successfully stored into the location referenced by "indexPtr". If * the Tcl object referenced by "objPtr" has the value "end", the - * value stored is "endValue". If "objPtr"s values is not of the form - * "end([+-]integer)?" and - * can not be converted to an integer, TCL_ERROR is returned and, if + * value stored is "endValue". If "objPtr"s values is not of one + * of the expected formats, TCL_ERROR is returned and, if * "interp" is non-NULL, an error message is left in the interpreter's * result object. * @@ -2313,10 +2312,51 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) *indexPtr = endValue + objPtr->internalRep.longValue; } else { + int opIdx, length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *p = bytes; + + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; + } + if (length == 0) { + goto parseError; + } + if ((*p == '+') || (*p == '-')) { + p++; length--; + } + opIdx = TclParseInteger(p, length) + (int) (p-bytes); + if (opIdx) { + int code, first, second; + char savedOp = bytes[opIdx]; + if ((savedOp != '+') && (savedOp != '-')) { + goto parseError; + } + if (isspace(UCHAR(bytes[opIdx+1]))) { + goto parseError; + } + bytes[opIdx] = '\0'; + code = Tcl_GetInt(interp, bytes, &first); + bytes[opIdx] = savedOp; + if (code == TCL_ERROR) { + goto parseError; + } + if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { + goto parseError; + } + if (savedOp == '+') { + *indexPtr = first + second; + } else { + *indexPtr = first - second; + } + return TCL_OK; + } + /* * Report a parse error. */ +parseError: if (interp != NULL) { char *bytes = Tcl_GetString(objPtr); /* @@ -2326,7 +2366,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) */ Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be integer?[+-]integer? or end?[+-]integer?", + (char *) NULL); if (!strncmp(bytes, "end-", 3)) { bytes += 3; } @@ -2383,7 +2424,7 @@ UpdateStringOfEndOffset(objPtr) * * SetEndOffsetFromAny -- * - * Look for a string of the form "end-offset" and convert it + * Look for a string of the form "end[+-]offset" and convert it * to an internal representation holding the offset. * * Results: @@ -2419,7 +2460,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?-integer?", (char*) NULL); + "\": must be end?[+-]integer?", (char*) NULL); } return TCL_ERROR; } @@ -2428,15 +2469,20 @@ SetEndOffsetFromAny(interp, objPtr) if (length <= 3) { offset = 0; - } else if ((length > 4) && (bytes[3] == '-')) { + } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything * after "end-" to Tcl_GetInt, then reverse for offset. */ + if (isspace(UCHAR(bytes[4]))) { + return TCL_ERROR; + } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { return TCL_ERROR; } - offset = -offset; + if (bytes[3] == '-') { + offset = -offset; + } } else { /* * Conversion failed. Report the error. @@ -2444,7 +2490,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be end?[+-]integer?", (char *) NULL); } return TCL_ERROR; } diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 156c4dd..443dd78 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.23 2004/10/14 17:20:11 dkf Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.24 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -59,7 +59,7 @@ test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} { } {1 {"-index" option must be followed by list index}} test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index foo {1 3 2 5}} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} diff --git a/tests/compile.test b/tests/compile.test index 6a2f16e..4cdc3be 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.36 2005/01/14 15:27:53 dkf Exp $ +# RCS: @(#) $Id: compile.test,v 1.37 2005/04/29 20:49:44 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -236,15 +236,15 @@ test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { lindex a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a 09 } list [catch {p} msg] $msg -} {1 {bad index "09": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; array set var {one two many} } list [catch {p} msg] $msg diff --git a/tests/lindex.test b/tests/lindex.test index 63d1548..2e180c2 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lindex.test,v 1.11 2003/11/14 20:44:46 dgp Exp $ +# RCS: @(#) $Id: lindex.test,v 1.12 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -49,7 +49,7 @@ test lindex-2.3 {multiple indices in list} testevalex { test lindex-2.4 {malformed index list} testevalex { set x \{ list [catch { testevalex {lindex {a b c} $x} } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -76,12 +76,12 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} testevalex { set x 08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.6 {bad octal} testevalex { set x -09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] @@ -118,31 +118,31 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} testevalex { set x end-08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-4.7 {bad octal} testevalex { set x end--09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-4.9 {incomplete end} testevalex { - set x en +test lindex-4.9 {obsolete test} testevalex { + set x end list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.10 {incomplete end-} testevalex { set x end- list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.1 {bad second index} testevalex { list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.2 {good second index} testevalex { testevalex {lindex {{a b c} {d e f} {g h i}} 1 2} @@ -245,7 +245,7 @@ test lindex-10.3 {multiple indices in list} { test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -284,12 +284,12 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} { set x 08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-11.6 {bad octal} { set x -09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} # Indices relative to end @@ -336,20 +336,20 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} { set x end-08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-12.7 {bad octal} { set x end--09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-12.9 {incomplete end} { - set x en +test lindex-12.9 {obsolete test} { + set x end catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result @@ -359,11 +359,11 @@ test lindex-12.9 {incomplete end} { test lindex-12.10 {incomplete end-} { set x end- list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.1 {bad second index} { list [catch { lindex {a b c} 0 0a2 } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.2 {good second index} { catch { diff --git a/tests/linsert.test b/tests/linsert.test index b3dcb6b..be8ae3d 100644 --- a/tests/linsert.test +++ b/tests/linsert.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: linsert.test,v 1.8 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: linsert.test,v 1.9 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -90,7 +90,7 @@ test linsert-2.2 {linsert errors} { } {1 {wrong # args: should be "linsert list index element ?element ...?"}} test linsert-2.3 {linsert errors} { list [catch {linsert a 12x 2} msg] $msg -} {1 {bad index "12x": must be integer or end?-integer?}} +} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}} test linsert-2.4 {linsert errors} { list [catch {linsert \{ 12 2} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lrange.test b/tests/lrange.test index 68e5d5e..aaaf81e 100644 --- a/tests/lrange.test +++ b/tests/lrange.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lrange.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lrange.test,v 1.8 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -43,7 +43,7 @@ test lrange-1.8 {range of list elements} { lrange {a b c d e} -2 -1 } {} test lrange-1.9 {range of list elements} { - lrange {a b c d e} -2 e + lrange {a b c d e} -2 end } {a b c d e} test lrange-1.10 {range of list elements} { lrange "a b\{c d" 1 2 @@ -55,7 +55,7 @@ test lrange-1.12 {range of list elements} { lrange "a b c d" end 100000 } d test lrange-1.13 {range of list elements} { - lrange "a b c d" e 3 + lrange "a b c d" end 3 } d test lrange-1.14 {range of list elements} { lrange "a b c d" end 2 @@ -75,10 +75,10 @@ test lrange-2.2 {error conditions} { } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.3 {error conditions} { list [catch {lrange a b 6} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg -} {1 {bad index "enigma": must be integer or end?-integer?}} +} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.5 {error conditions} { list [catch {lrange "a \{b c" 3 4} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lreplace.test b/tests/lreplace.test index d3ca611..99b236e 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lreplace.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lreplace.test,v 1.8 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -110,13 +110,13 @@ test lreplace-2.2 {lreplace errors} { } {1 {wrong # args: should be "lreplace list first last ?element element ...?"}} test lreplace-2.3 {lreplace errors} { list [catch {lreplace x a 10} msg] $msg -} {1 {bad index "a": must be integer or end?-integer?}} +} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer or end?-integer?}} +} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer or end?-integer?}} +} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.6 {lreplace errors} { list [catch {lreplace x 3 2} msg] $msg } {1 {list doesn't contain element 3}} diff --git a/tests/lsearch.test b/tests/lsearch.test index aded40b..d509407 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lsearch.test,v 1.13 2003/10/15 13:15:45 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.14 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -284,7 +284,7 @@ test lsearch-10.3 {offset searching} { } 3 test lsearch-10.4 {offset searching} { list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg -} {1 {bad index "foobar": must be integer or end?-integer?}} +} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-10.5 {offset searching} { list [catch {lsearch -start 1 2} msg] $msg } {1 {missing starting index}} @@ -415,7 +415,7 @@ test lsearch-20.1 {lsearch -index option, index larger than sublists} { } {1 {element 2 missing from sublist "a c"}} test lsearch-20.2 {lsearch -index option, malformed index} { list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-20.3 {lsearch -index option, malformed index} { list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lset.test b/tests/lset.test index 048e9ba..00facb2 100644 --- a/tests/lset.test +++ b/tests/lset.test @@ -51,7 +51,7 @@ test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} te list [catch { testevalex {lset x {{bad}1} 3} } msg] $msg -} "1 {bad index \"{bad}1\": must be integer or end?-integer?}" +} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}} test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1 2} @@ -99,7 +99,7 @@ test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a [list 2a2] w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -141,7 +141,7 @@ test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a 2a2 w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -300,12 +300,12 @@ test lset-8.2 {lset, not compiled, malformed sublist} testevalex { test lset-8.3 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a 0 2a2 f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.4 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a {0 2a2} f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.5 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} diff --git a/tests/regexp.test b/tests/regexp.test index fe4221b..f190298 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: regexp.test,v 1.25 2003/10/14 18:23:31 vincentdarley Exp $ +# RCS: @(#) $Id: regexp.test,v 1.26 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -220,7 +220,7 @@ test regexp-6.8 {regexp errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo @@ -377,7 +377,7 @@ test regexp-11.7 {regsub errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} @@ -467,6 +467,20 @@ test regexp-15.5 {regexp -start, over end of string} { test regexp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} +test regexp-15.7 {regexp -start, double option} { + regexp -start 2 -start 0 a abc +} 1 +test regexp-15.8 {regexp -start, double option} { + regexp -start 0 -start 2 a abc +} 0 +test regexp-15.9 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end {\d} 1abc2de3 x] [info exists x] +} {0 0} +test regexp-15.10 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x +} {1 1 3} test regexp-16.1 {regsub -start} { catch {unset x} @@ -485,6 +499,18 @@ test regexp-16.4 {regsub -start, \A behavior} { lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} +test regexp-16.5 {regsub -start, double option} { + list [regsub -start 2 -start 0 a abc c x] $x +} {1 cbc} +test regexp-16.6 {regsub -start, double option} { + list [regsub -start 0 -start 2 a abc c x] $x +} {0 abc} +test regexp-16.7 {regexp -start, end relative index} { + list [regsub -start end a aaa b x] $x +} {0 aaa} +test regexp-16.8 {regexp -start, end relative index} { + list [regsub -start end-1 a aaa b x] $x +} {1 aab} test regexp-17.1 {regexp -inline} { regexp -inline b ababa diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 6580d60..a84099e 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -301,7 +301,7 @@ test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexpComp-7.1 {basic regsub operation} { evalInProc { @@ -542,7 +542,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... diff --git a/tests/string.test b/tests/string.test index 45bb587..c7a9f51 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.45 2005/04/22 16:26:04 dgp Exp $ +# RCS: @(#) $Id: string.test,v 1.46 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -176,7 +176,7 @@ test string-4.1 {string first, too few args} { } {1 {wrong # args: should be "string first subString string ?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 or end?-integer?}} +} {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 subString string ?startIndex?"}} @@ -241,7 +241,7 @@ test string-5.6 {string index} { } {0 {}} test string-5.7 {string index} { list [catch {string index a xyz} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test string-5.8 {string index} { string index abc end } c @@ -276,10 +276,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} { list [catch {string index "abc" 08} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.18 {string index, bad integer} { list [catch {string index "abc" end-00289} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} @@ -667,7 +667,7 @@ test string-7.1 {string last, too few args} { } {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-7.3 {string last, too many args} { list [catch {string last a b c d} msg] $msg } {1 {wrong # args: should be "string last subString string ?startIndex?"}} @@ -1022,7 +1022,7 @@ test string-12.5 {string range, last > length} { string range abcdefghijklmnop 7 1000 } {hijklmnop} test string-12.6 {string range} { - string range abcdefghijklmnop 10 e + string range abcdefghijklmnop 10 end } {klmnop} test string-12.7 {string range, last < first} { string range abcdefghijklmnop 10 9 @@ -1041,15 +1041,15 @@ test string-12.11 {string range} { } {abcdefghijklmnop} test string-12.12 {string range} { list [catch {string range abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.13 {string range} { list [catch {string range abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.14 {string range} { string range abcdefghijklmnop end-1 end } {op} test string-12.15 {string range} { - string range abcdefghijklmnop e 1000 + string range abcdefghijklmnop end 1000 } {p} test string-12.16 {string range} { string range abcdefghijklmnop end end-1 @@ -1132,7 +1132,7 @@ test string-14.6 {string replace} { string replace abcdefghijklmnop 7 1000 } {abcdefg} test string-14.7 {string replace} { - string replace abcdefghijklmnop 10 e + string replace abcdefghijklmnop 10 end } {abcdefghij} test string-14.8 {string replace} { string replace abcdefghijklmnop 10 9 @@ -1151,15 +1151,15 @@ test string-14.12 {string replace} { } {} test string-14.13 {string replace} { list [catch {string replace abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.14 {string replace} { list [catch {string replace abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.15 {string replace} { string replace abcdefghijklmnop end-10 end-2 NEW } {abcdeNEWop} test string-14.16 {string replace} { - string replace abcdefghijklmnop 0 e foo + string replace abcdefghijklmnop 0 end foo } {foo} test string-14.17 {string replace} { string replace abcdefghijklmnop end end-1 @@ -1170,7 +1170,7 @@ test string-15.1 {string tolower too few args} { } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test string-15.2 {string tolower bad args} { list [catch {string tolower a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-15.3 {string tolower too many args} { list [catch {string tolower ABC 1 end oops} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} @@ -1201,7 +1201,7 @@ test string-16.1 {string toupper} { } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test string-16.2 {string toupper} { list [catch {string toupper a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-16.3 {string toupper} { list [catch {string toupper a 1 end oops} msg] $msg } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} @@ -1232,7 +1232,7 @@ test string-17.1 {string totitle} { } {1 {wrong # args: should be "string totitle string ?first? ?last?"}} test string-17.2 {string totitle} { list [catch {string totitle a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-17.3 {string totitle} { string totitle abCDEf } {Abcdef} @@ -1314,7 +1314,7 @@ test string-21.2 {string wordend} { } {1 {wrong # args: should be "string wordend string index"}} test string-21.3 {string wordend} { list [catch {string wordend a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-21.4 {string wordend} { string wordend abc. -1 } 3 @@ -1360,7 +1360,7 @@ test string-22.3 {string wordstart} { } {1 {wrong # args: should be "string wordstart string index"}} test string-22.4 {string wordstart} { list [catch {string wordstart a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-22.5 {string wordstart} { string wordstart "one two three_words" 400 } 8 diff --git a/tests/stringComp.test b/tests/stringComp.test index e2cd121..6af2be4 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringComp.test,v 1.8 2004/05/25 18:58:05 dgp Exp $ +# RCS: @(#) $Id: stringComp.test,v 1.9 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -226,7 +226,7 @@ test stringComp-4.1 {string first, too few args} { 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 or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-4.3 {string first, too many args} { proc foo {} {string first a b 5 d} list [catch {foo} msg] $msg @@ -303,7 +303,7 @@ test stringComp-5.6 {string index} { test stringComp-5.7 {string index} { proc foo {} {string index a xyz} list [catch {foo} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-5.8 {string index} { proc foo {} {string index abc end} foo @@ -352,11 +352,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} { proc foo {} {string index "abc" 08} list [catch {foo} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.18 {string index, bad integer} { proc foo {} {string index "abc" end-00289} list [catch {foo} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/util.test b/tests/util.test index ae3d0c5..e097efa 100644 --- a/tests/util.test +++ b/tests/util.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.14 2004/05/19 20:15:32 dkf Exp $ +# RCS: @(#) $Id: util.test,v 1.15 2005/04/29 20:49:45 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -388,6 +388,190 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { list [llength [testdstring get]] [string length [testdstring get]] } {2 9} +test util-9.0.0 {TclGetIntForIndex} { + string index abcd 0 +} a +test util-9.0.1 {TclGetIntForIndex} { + string index abcd 0x0 +} a +test util-9.0.2 {TclGetIntForIndex} { + string index abcd -0x0 +} a +test util-9.0.3 {TclGetIntForIndex} { + string index abcd { 0 } +} a +test util-9.0.4 {TclGetIntForIndex} { + string index abcd { 0x0 } +} a +test util-9.0.5 {TclGetIntForIndex} { + string index abcd { -0x0 } +} a +test util-9.0.6 {TclGetIntForIndex} { + string index abcd 01 +} b +test util-9.0.7 {TclGetIntForIndex} { + string index abcd { 01 } +} b +test util-9.1.0 {TclGetIntForIndex} { + string index abcd 3 +} d +test util-9.1.1 {TclGetIntForIndex} { + string index abcd { 3 } +} d +test util-9.1.2 {TclGetIntForIndex} { + string index abcdefghijk 0xa +} k +test util-9.1.3 {TclGetIntForIndex} { + string index abcdefghijk { 0xa } +} k +test util-9.2.0 {TclGetIntForIndex} { + string index abcd end +} d +test util-9.2.1 {TclGetIntForIndex} -body { + string index abcd { end} +} -returnCodes error -match glob -result * +test util-9.2.2 {TclGetIntForIndex} -body { + string index abcd {end } +} -returnCodes error -match glob -result * +test util-9.3 {TclGetIntForIndex} { + # Deprecated + string index abcd en +} d +test util-9.4 {TclGetIntForIndex} { + # Deprecated + string index abcd e +} d +test util-9.5.0 {TclGetIntForIndex} { + string index abcd end-1 +} c +test util-9.5.1 {TclGetIntForIndex} { + string index abcd {end-1 } +} c +test util-9.5.2 {TclGetIntForIndex} -body { + string index abcd { end-1} +} -returnCodes error -match glob -result * +test util-9.6 {TclGetIntForIndex} { + string index abcd end+-1 +} c +test util-9.7 {TclGetIntForIndex} { + string index abcd end+1 +} {} +test util-9.8 {TclGetIntForIndex} { + string index abcd end--1 +} {} +test util-9.9.0 {TclGetIntForIndex} { + string index abcd 0+0 +} a +test util-9.9.1 {TclGetIntForIndex} { + string index abcd { 0+0 } +} a +test util-9.10 {TclGetIntForIndex} { + string index abcd 0-0 +} a +test util-9.11 {TclGetIntForIndex} { + string index abcd 1+0 +} b +test util-9.12 {TclGetIntForIndex} { + string index abcd 1-0 +} b +test util-9.13 {TclGetIntForIndex} { + string index abcd 1+1 +} c +test util-9.14 {TclGetIntForIndex} { + string index abcd 1-1 +} a +test util-9.15 {TclGetIntForIndex} { + string index abcd -1+2 +} b +test util-9.16 {TclGetIntForIndex} { + string index abcd -1--2 +} b +test util-9.17 {TclGetIntForIndex} { + string index abcd { -1+2 } +} b +test util-9.18 {TclGetIntForIndex} { + string index abcd { -1--2 } +} b +test util-9.19 {TclGetIntForIndex} -body { + string index a {} +} -returnCodes error -match glob -result * +test util-9.20 {TclGetIntForIndex} -body { + string index a { } +} -returnCodes error -match glob -result * +test util-9.21 {TclGetIntForIndex} -body { + string index a " \r\t\n" +} -returnCodes error -match glob -result * +test util-9.22 {TclGetIntForIndex} -body { + string index a + +} -returnCodes error -match glob -result * +test util-9.23 {TclGetIntForIndex} -body { + string index a - +} -returnCodes error -match glob -result * +test util-9.24 {TclGetIntForIndex} -body { + string index a x +} -returnCodes error -match glob -result * +test util-9.25 {TclGetIntForIndex} -body { + string index a +x +} -returnCodes error -match glob -result * +test util-9.26 {TclGetIntForIndex} -body { + string index a -x +} -returnCodes error -match glob -result * +test util-9.27 {TclGetIntForIndex} -body { + string index a 0y +} -returnCodes error -match glob -result * +test util-9.28 {TclGetIntForIndex} -body { + string index a 1* +} -returnCodes error -match glob -result * +test util-9.29 {TclGetIntForIndex} -body { + string index a 0+ +} -returnCodes error -match glob -result * +test util-9.30 {TclGetIntForIndex} -body { + string index a {0+ } +} -returnCodes error -match glob -result * +test util-9.31 {TclGetIntForIndex} -body { + string index a 0x +} -returnCodes error -match glob -result * +test util-9.32 {TclGetIntForIndex} -body { + string index a 0x1FFFFFFFF+0 +} -returnCodes error -match glob -result * +test util-9.33 {TclGetIntForIndex} -body { + string index a 100000000000+0 +} -returnCodes error -match glob -result * +test util-9.34 {TclGetIntForIndex} -body { + string index a 1.0 +} -returnCodes error -match glob -result * +test util-9.35 {TclGetIntForIndex} -body { + string index a 1e23 +} -returnCodes error -match glob -result * +test util-9.36 {TclGetIntForIndex} -body { + string index a 1.5e2 +} -returnCodes error -match glob -result * +test util-9.37 {TclGetIntForIndex} -body { + string index a 0+x +} -returnCodes error -match glob -result * +test util-9.38 {TclGetIntForIndex} -body { + string index a 0+0x +} -returnCodes error -match glob -result * +test util-9.39 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.40 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.41 {TclGetIntForIndex} -body { + string index a 0+1.0 +} -returnCodes error -match glob -result * +test util-9.42 {TclGetIntForIndex} -body { + string index a 0+1e2 +} -returnCodes error -match glob -result * +test util-9.43 {TclGetIntForIndex} -body { + string index a 0+1.5e1 +} -returnCodes error -match glob -result * +test util-9.44 {TclGetIntForIndex} -body { + string index a 0+1000000000000 +} -returnCodes error -match glob -result * + + # cleanup ::tcltest::cleanupTests return |