From cbfd4003a1395d9f6ec97acf62eb239f7c3fafca Mon Sep 17 00:00:00 2001 From: stanton Date: Tue, 4 May 1999 01:33:10 +0000 Subject: * tests/cmdIL.test: * tests/cmdMZ.test: * tests/error.test: * tests/lindex.test: * tests/linsert.test: * tests/lrange.test: * tests/lreplace.test: * tests/string.test: * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's string patch which includes the following changes [Bug: 1845]: --- doc/string.n | 135 ++++++++++++++++---- generic/tclCmdMZ.c | 354 ++++++++++++++++++++++++++++++++++++++++++++-------- generic/tclUtil.c | 48 ++++--- tests/cmdIL.test | 4 +- tests/cmdMZ.test | 38 +++--- tests/error.test | 6 +- tests/lindex.test | 4 +- tests/linsert.test | 4 +- tests/lrange.test | 6 +- tests/lreplace.test | 8 +- tests/string.test | 318 +++++++++++++++++++++++++++++++++++++--------- 11 files changed, 738 insertions(+), 187 deletions(-) diff --git a/doc/string.n b/doc/string.n index 42d6e0b..0071b32 100644 --- a/doc/string.n +++ b/doc/string.n @@ -5,10 +5,10 @@ '\" 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.3 1999/04/16 00:46:36 stanton Exp $ +'\" RCS: @(#) $Id: string.n,v 1.4 1999/05/04 01:33:10 stanton Exp $ '\" .so man.macros -.TH string n 7.6 Tcl "Tcl Built-In Commands" +.TH string n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -21,12 +21,23 @@ string \- Manipulate strings .PP Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: +.VS 8.1 .TP -\fBstring compare \fIstring1 string2\fR +\fBstring compare \fIstring1 string2\fR ?\fIlength\fR? +.VE 8.1 Perform a character-by-character comparison of strings \fIstring1\fR and \fIstring2\fR in the same way as the C \fBstrcmp\fR procedure. Return \-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically less than, equal to, or greater than \fIstring2\fR. +.VS 8.1 +If \fIlength\fR is +specified, it works like C \fBstrncmp\fR, comparing only to the +specified length. If \fIlength\fR is negative, it is ignored. +.TP +\fBstring equal \fIstring1 string2\fR ?\fIlength\fR? +.VE 8.1 +Like the \fBcompare\fR method, but returns 1 when the strings +are equal, or 0 when not. .TP \fBstring first \fIstring1 string2\fR Search \fIstring2\fR for a sequence of characters that exactly match @@ -34,10 +45,38 @@ the characters in \fIstring1\fR. If found, return the index of the first character in the first such match within \fIstring2\fR. If not found, return \-1. .TP +\fBstring icompare \fIstring1 string2\fR ?\fIlength\fR? +Perform a case-insensitive character-by-character comparison of strings +\fIstring1\fR and +\fIstring2\fR in the same way as the C \fBstrcasecmp\fR procedure. Return +\-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically +less than, equal to, or greater than \fIstring2\fR. If length is +specified, it works like C \fBstrncasecmp\fR, comparing only to the +specified length. +.TP +\fBstring iequal \fIstring1 string2\fR ?\fIlength\fR? +Like the \fBicompare\fR method, but returns 1 when the strings +are equal, or 0 when not. +.TP \fBstring index \fIstring charIndex\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. +character of the string. +.VS 8.1 +\fIcharIndex\fR may be specified as +follows: +.RS +.IP \fB[\fInumber\fB]\fR 10 +The char specified at this numerical index +.IP \fBend\fR 10 +The last char of the string. +.IP \fBexpression\fR 10 +A Tcl expression that returns a number. +.IP \fBend[+-]expression\fR 10 +The last char of the string plus or minus the number specified +in the expression (ie: end-1). +.RE +.VE 8.1 If \fIcharIndex\fR is less than 0 or greater than or equal to the length of the string then an empty string is returned. @@ -50,6 +89,25 @@ is no match, then return \-1. .TP \fBstring length \fIstring\fR Returns a decimal string giving the number of characters in \fIstring\fR. +.VS 8.1 +.TP +\fBstring map ?\fIoptions\fR? \fIcharMap string\fR +Replaces characters in \fIstring\fR based on the key-value pairs in +\fIcharMap\fR. \fIcharMap\fR is a list of key value key value ... as +in the form returned by \fBarray get\fR. Each instance of a key in +the string will be replace with its corresponding value. Both key and +value may be multiple characters. This is done +in an ordered manner, so the key appearing first in the list will be +checked first, and so on. \fIstring\fR is only iterated over once, +so earlier key replacements will have no affect for later key matches. +For example, +.RS +.CS +\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR +.CE +will return the string \fB01321221\fR. +.RE +.VE 8.1 .TP \fBstring match \fIpattern\fR \fIstring\fR See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0 @@ -78,29 +136,58 @@ avoiding the special interpretation of the characters Returns a range of consecutive characters from \fIstring\fR, starting with the character whose index is \fIfirst\fR and ending with the character whose index is \fIlast\fR. An index of 0 refers to the -first character of the string. -An index of \fBend\fR (or any -abbreviation of it) refers to the last character of the string. +.VS 8.1 +first character of the string. \fIfirst\fR and \fIlast\fR may be +specified as for the \fBindex\fR method. +.VE 8.1 If \fIfirst\fR is less than zero then it is treated as if it were zero, and if \fIlast\fR is greater than or equal to the length of the string then it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than \fIlast\fR then an empty string is returned. -.VS +.VS 8.1 +.TP +\fBstring repeat \fIstring count\fR +Returns \fIstring\fR repeated \fIcount\fR number of times. +.TP +\fBstring replace \fIstring last\fR ?\fIstring\fR? +Removes a range of consecutive characters from \fIstring\fR, starting +with the character whose index is \fIfirst\fR and ending with the +character whose index is \fIlast\fR. An index of 0 refers to the +first character of the string. \fIfirst\fR and \fIlast\fR may be +specified as for the \fBindex\fR method. If \fIstring\fR is +specified, then it is placed in the removed character range. +If \fIfirst\fR is less than zero then it is treated as if it were zero, and +if \fIlast\fR is greater than or equal to the length of the string then +it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than +\fIlast\fR or the length of the initial string, or \fIlast\fR is less +than 0, then the initial string is returned untouched. .TP -\fBstring tolower \fIstring\fR -Returns a value equal to \fIstring\fR except that all upper (or title) -case letters have been converted to lower case. +\fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? +Returns a value equal to \fIstring\fR except that all upper (or title) case +letters have been converted to lower case. If \fIfirst\fR is specified, it +refers to the first char index in the string to start modifying. If +\fIlast\fR is specified, it refers to the char index in the string to stop +at (inclusive). \fIfirst\fR and \fIlast\fR may be +specified as for the \fBindex\fR method. .TP -\fBstring totitle \fIstring\fR +\fBstring totitle \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? Returns a value equal to \fIstring\fR except that the first character in \fIstring\fR is converted to its Unicode title case variant (or upper case if there is no title case variant) and the rest of the string is -converted to lower case. +converted to lower case. If \fIfirst\fR is specified, it +refers to the first char index in the string to start modifying. If +\fIlast\fR is specified, it refers to the char index in the string to stop +at (inclusive). \fIfirst\fR and \fIlast\fR may be +specified as for the \fBindex\fR method. .TP -\fBstring toupper \fIstring\fR -Returns a value equal to \fIstring\fR except that all lower (or title) -case letters have been converted to upper case. -.VE +\fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? +Returns a value equal to \fIstring\fR except that all lower (or title) case +letters have been converted to upper case. If \fIfirst\fR is specified, it +refers to the first char index in the string to start modifying. If +\fIlast\fR is specified, it refers to the char index in the string to stop +at (inclusive). \fIfirst\fR and \fIlast\fR may be specified as for the +\fBindex\fR method. +.VE 8.1 .TP \fBstring trim \fIstring\fR ?\fIchars\fR? Returns a value equal to \fIstring\fR except that any leading @@ -122,22 +209,24 @@ trailing characters from the set given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (spaces, tabs, newlines, and carriage returns). -.VS +.VS 8.1 .TP -\fBstring wordend \fIstring index\fR +\fBstring wordend \fIstring charIndex\fR Returns the index of the character just after the last one in the word -containing character \fIindex\fR of \fIstring\fR. A word is +containing character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR +may be specified as for the \fBindex\fR method. A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) or underscore (Unicode connector punctuation) characters, or any single character other than these. .TP -\fBstring wordstart \fIstring index\fR +\fBstring wordstart \fIstring charIndex\fR Returns the index of the first character in the word containing -character \fIindex\fR of \fIstring\fR. A word is considered to be any +character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR may be +specified as for the \fBindex\fR method. A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) or underscore (Unicode connector punctuation) characters, or any single character other than these. -.VE +.VE 8.1 .SH KEYWORDS case conversion, compare, index, match, pattern, string, word diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 38a3f8d..52cdf10 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -13,7 +13,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.3 1999/04/16 00:46:43 stanton Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.4 1999/05/04 01:33:10 stanton Exp $ */ #include "tclInt.h" @@ -806,16 +806,22 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) char *string1, *string2; int length1, length2; static char *options[] = { - "compare", "first", "index", "last", - "length", "match", "range", "tolower", - "toupper", "totitle", "trim", "trimleft", - "trimright", "wordend", "wordstart", (char *) NULL + "bytes", "compare", "equal", "first", + "icompare", "iequal", "index", + "last", "length", "map", + "match", "range", "repeat", "replace", + "tolower", "toupper", "totitle", + "trim", "trimleft", "trimright", + "wordend", "wordstart", (char *) NULL }; enum options { - STR_COMPARE, STR_FIRST, STR_INDEX, STR_LAST, - STR_LENGTH, STR_MATCH, STR_RANGE, STR_TOLOWER, - STR_TOUPPER, STR_TOTITLE, STR_TRIM, STR_TRIMLEFT, - STR_TRIMRIGHT, STR_WORDEND, STR_WORDSTART + STR_BYTES, STR_COMPARE, STR_EQUAL, STR_FIRST, + STR_ICOMPARE, STR_IEQUAL, STR_INDEX, + STR_LAST, STR_LENGTH, STR_MAP, + STR_MATCH, STR_RANGE, STR_REPEAT, STR_REPLACE, + STR_TOLOWER, STR_TOUPPER, STR_TOTITLE, + STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT, + STR_WORDEND, STR_WORDSTART }; if (objc < 2) { @@ -830,11 +836,65 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) resultPtr = Tcl_GetObjResult(interp); switch ((enum options) index) { + case STR_EQUAL: case STR_COMPARE: { - int match, length; + int match, length, reqlength = -1; - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "string1 string2"); + if (!(objc == 4 || objc == 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "string1 string2 ?length?"); + return TCL_ERROR; + } + if ((objc == 5) && + Tcl_GetIntFromObj(interp, objv[4], &reqlength) != TCL_OK) { + return TCL_ERROR; + } + + string1 = Tcl_GetStringFromObj(objv[2], &length1); + string2 = Tcl_GetStringFromObj(objv[3], &length2); + + length = (length1 < length2) ? length1 : length2; + if ((reqlength >= 0) && (reqlength < length)) { + Tcl_UniChar ch1, ch2; + + /* + * reqlength must be interpreted as chars, not bytes + * we will only enter here when both strings are of + * at least reqlength chars long (no need for \0 check) + */ + match = 0; + while (reqlength-- > 0) { + string1 += Tcl_UtfToUniChar(string1, &ch1); + string2 += Tcl_UtfToUniChar(string2, &ch2); + if (ch1 != ch2) { + match = ch1 - ch2; + break; + } + } + } else { + match = memcmp(string1, string2, (unsigned) length); + if (match == 0) { + match = length1 - length2; + } + } + if ((enum options) index == STR_EQUAL) { + Tcl_SetIntObj(resultPtr, (match) ? 0 : 1); + } else { + Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 : + (match < 0) ? -1 : 0)); + } + break; + } + case STR_IEQUAL: + case STR_ICOMPARE: { + int match, length, reqlength = -1; + Tcl_UniChar ch1, ch2; + + if (objc < 4 || objc > 5) { + Tcl_WrongNumArgs(interp, 2, objv, "string1 string2 ?length?"); + return TCL_ERROR; + } + if ((objc == 5) && + Tcl_GetIntFromObj(interp, objv[4], &reqlength) != TCL_OK) { return TCL_ERROR; } @@ -842,11 +902,34 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) string2 = Tcl_GetStringFromObj(objv[3], &length2); length = (length1 < length2) ? length1 : length2; - match = memcmp(string1, string2, (unsigned) length); - if (match == 0) { - match = length1 - length2; + if ((reqlength >= 0) && (reqlength < length)) { + length = reqlength; + } + /* + * length must be interpreted as chars, not bytes + * we will only enter here when both strings are of + * at least length chars long (no need for \0 check) + */ + match = 0; + while (length-- > 0) { + string1 += Tcl_UtfToUniChar(string1, &ch1); + string2 += Tcl_UtfToUniChar(string2, &ch2); + if ((ch1 != ch2) && + (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2))) { + match = ch1 - ch2; + break; + } + } + if ((match == 0) && (reqlength >= length)) { + match = length1 - length2; + } + + if ((enum options) index == STR_IEQUAL) { + Tcl_SetIntObj(resultPtr, (match) ? 0 : 1); + } else { + Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 : + (match < 0) ? -1 : 0)); } - Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0); break; } case STR_FIRST: { @@ -897,29 +980,25 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } case STR_INDEX: { int index; - Tcl_UniChar ch; char buf[TCL_UTF_MAX]; - char *start, *end; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "string charIndex"); return TCL_ERROR; } - - if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) { - return TCL_ERROR; + string1 = Tcl_GetStringFromObj(objv[2], &length1); + /* + * establish what 'end' really means + */ + length2 = Tcl_NumUtfChars(string1, length1) - 1; + if (TclGetIntForIndex(interp, objv[3], length2, + &index) != TCL_OK) { + return TCL_ERROR; } - if (index >= 0) { - start = Tcl_GetStringFromObj(objv[2], &length1); - end = start + length1; - for ( ; start < end; index--) { - start += Tcl_UtfToUniChar(start, &ch); - if (index == 0) { - Tcl_SetStringObj(resultPtr, buf, - Tcl_UniCharToUtf(ch, buf)); - break; - } - } + if ((index >= 0) && (index < length1)) { + length2 = Tcl_UniCharToUtf(Tcl_UniCharAtIndex(string1, + index), buf); + Tcl_SetStringObj(resultPtr, buf, length2); } break; } @@ -965,6 +1044,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) Tcl_SetIntObj(resultPtr, match); break; } + case STR_BYTES: case STR_LENGTH: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "string"); @@ -972,7 +1052,70 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } string1 = Tcl_GetStringFromObj(objv[2], &length1); - Tcl_SetIntObj(resultPtr, Tcl_NumUtfChars(string1, length1)); + if ((enum options) index == STR_BYTES) { + Tcl_SetIntObj(resultPtr, length1); + } else { + Tcl_SetIntObj(resultPtr, Tcl_NumUtfChars(string1, length1)); + } + break; + } + case STR_MAP: { + int mapElemc, len; + Tcl_Obj **mapElemv; + char *end; + Tcl_UniChar ch; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "charMap string"); + return TCL_ERROR; + } + + if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc, + &mapElemv) != TCL_OK) { + return TCL_ERROR; + } + if (mapElemc & 1) { + /* + * The charMap must be an even number of key/value items + */ + Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1); + return TCL_ERROR; + } + string1 = Tcl_GetStringFromObj(objv[objc-1], &length1); + if (length1 == 0) { + break; + } + end = string1 + length1; + + for ( ; string1 < end; string1 += len) { + len = Tcl_UtfToUniChar(string1, &ch); + for (index = 0; index < mapElemc; index +=2) { + /* + * Get the key string to match on + */ + string2 = Tcl_GetStringFromObj(mapElemv[index], &length2); + if ((*string2 == *string1) && + (memcmp(string2, string1, length2) == 0)) { + /* + * Adjust len to be full length of matched string + */ + len = length2; + /* + * Change string2 and length2 to the replacement value + */ + string2 = Tcl_GetStringFromObj(mapElemv[index+1], + &length2); + Tcl_AppendToObj(resultPtr, string2, length2); + break; + } + } + if (index == mapElemc) { + /* + * No match was found, put the char onto result + */ + Tcl_AppendToObj(resultPtr, string1, len); + } + } break; } case STR_MATCH: { @@ -1019,32 +1162,133 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } break; } + case STR_REPEAT: { + int count; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "string count"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) { + return TCL_ERROR; + } + + string1 = Tcl_GetStringFromObj(objv[2], &length1); + if (length1 > 0) { + for (index = 0; index < count; index++) { + Tcl_AppendToObj(resultPtr, string1, length1); + } + } + break; + } + case STR_REPLACE: { + int first, last; + + if (!(objc == 5 || objc == 6)) { + Tcl_WrongNumArgs(interp, 2, objv, "string first last ?string?"); + return TCL_ERROR; + } + + string1 = Tcl_GetStringFromObj(objv[2], &length1); + length1 = Tcl_NumUtfChars(string1, length1) - 1; + if (TclGetIntForIndex(interp, objv[3], length1, + &first) != TCL_OK) { + return TCL_ERROR; + } + if (TclGetIntForIndex(interp, objv[4], length1, + &last) != TCL_OK) { + return TCL_ERROR; + } + if ((last < first) || (first > length1) || (last < 0)) { + Tcl_SetObjResult(interp, objv[2]); + } else { + char *start, *end; + + if (first < 0) { + first = 0; + } + start = Tcl_UtfAtIndex(string1, first); + end = Tcl_UtfAtIndex(start, ((last > length1) ? length1 : last) + - first + 1); + Tcl_SetStringObj(resultPtr, string1, start - string1); + if (objc == 6) { + Tcl_AppendObjToObj(resultPtr, objv[5]); + } + if (last < length1) { + Tcl_AppendToObj(resultPtr, end, -1); + } + } + break; + } case STR_TOLOWER: case STR_TOUPPER: case STR_TOTITLE: - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "string"); + if (objc < 3 || objc > 5) { + Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[2], &length1); - /* - * Since the result object is not a shared object, it is - * safe to copy the string into the result and do the - * conversion in place. The conversion may change the length - * of the string, so reset the length after conversion. - */ - - Tcl_SetStringObj(resultPtr, string1, length1); - if ((enum options) index == STR_TOLOWER) { - length1 = Tcl_UtfToLower(Tcl_GetStringFromObj(resultPtr, NULL)); - } else if ((enum options) index == STR_TOUPPER) { - length1 = Tcl_UtfToUpper(Tcl_GetStringFromObj(resultPtr, NULL)); + if (objc == 3) { + /* + * Since the result object is not a shared object, it is + * safe to copy the string into the result and do the + * conversion in place. The conversion may change the length + * of the string, so reset the length after conversion. + */ + + Tcl_SetStringObj(resultPtr, string1, length1); + if ((enum options) index == STR_TOLOWER) { + length1 = Tcl_UtfToLower(Tcl_GetStringFromObj(resultPtr, NULL)); + } else if ((enum options) index == STR_TOUPPER) { + length1 = Tcl_UtfToUpper(Tcl_GetStringFromObj(resultPtr, NULL)); + } else { + length1 = Tcl_UtfToTitle(Tcl_GetStringFromObj(resultPtr, NULL)); + } + Tcl_SetObjLength(resultPtr, length1); } else { - length1 = Tcl_UtfToTitle(Tcl_GetStringFromObj(resultPtr, NULL)); + int first, last; + char *start, *end; + + length1 = Tcl_NumUtfChars(string1, length1) - 1; + if (TclGetIntForIndex(interp, objv[3], length1, + &first) != TCL_OK) { + return TCL_ERROR; + } + if (first < 0) { + first = 0; + } + last = first; + if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1, + &last) != TCL_OK)) { + return TCL_ERROR; + } + if (last >= length1) { + last = length1; + } + if (last < first) { + Tcl_SetObjResult(interp, objv[2]); + break; + } + start = Tcl_UtfAtIndex(string1, first); + end = Tcl_UtfAtIndex(start, last - first + 1); + length2 = end-start; + string2 = ckalloc(length2+1); + memcpy(string2, start, length2); + string2[length2] = '\0'; + if ((enum options) index == STR_TOLOWER) { + length2 = Tcl_UtfToLower(string2); + } else if ((enum options) index == STR_TOUPPER) { + length2 = Tcl_UtfToUpper(string2); + } else { + length2 = Tcl_UtfToTitle(string2); + } + Tcl_SetStringObj(resultPtr, string1, start - string1); + Tcl_AppendToObj(resultPtr, string2, length2); + Tcl_AppendToObj(resultPtr, end, -1); } - Tcl_SetObjLength(resultPtr, length1); break; case STR_TRIM: { @@ -1147,13 +1391,14 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } string1 = Tcl_GetStringFromObj(objv[2], &length1); - if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) { - return TCL_ERROR; + numChars = Tcl_NumUtfChars(string1, length1); + if (TclGetIntForIndex(interp, objv[3], numChars-1, + &index) != TCL_OK) { + return TCL_ERROR; } if (index < 0) { index = 0; } - numChars = Tcl_NumUtfChars(string1, length1); if (index < numChars) { p = Tcl_UtfAtIndex(string1, index); end = string1+length1; @@ -1184,10 +1429,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } string1 = Tcl_GetStringFromObj(objv[2], &length1); - if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string1, length1); + if (TclGetIntForIndex(interp, objv[3], numChars-1, + &index) != TCL_OK) { return TCL_ERROR; } - numChars = Tcl_NumUtfChars(string1, length1); if (index >= numChars) { index = numChars - 1; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 095100f..2031ccd 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -10,7 +10,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.8 1999/04/21 21:50:29 rjohnson Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.9 1999/05/04 01:33:11 stanton Exp $ */ #include "tclInt.h" @@ -2051,31 +2051,45 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) int *indexPtr; /* Location filled in with an integer * representing an index. */ { - Interp *iPtr = (Interp *) interp; char *bytes; - int index, length, result; + long longResult; + int length; if (objPtr->typePtr == &tclIntType) { *indexPtr = (int)objPtr->internalRep.longValue; return TCL_OK; } - + bytes = Tcl_GetStringFromObj(objPtr, &length); - if ((*bytes == 'e') - && (strncmp(bytes, "end", (unsigned) length) == 0)) { - index = endValue; + + if ((*bytes != 'e') || + (strncmp(bytes, "end", (length > 3) ? 3 : length) != 0)) { + if (Tcl_ExprLongObj(interp, objPtr, &longResult) != TCL_OK) { + return TCL_ERROR; + } + *indexPtr = longResult; + return TCL_OK; + } + + if (length <= 3) { + *indexPtr = endValue; + } else if ((bytes[3] == '+') || (bytes[3] == '-')) { + /* + * This is our limited string expression evaluator + */ + if (Tcl_ExprLong(interp, bytes+3, &longResult) != TCL_OK) { + return TCL_ERROR; + } + *indexPtr = endValue + longResult; } else { - result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objPtr, &index); - if (result != TCL_OK) { - if (iPtr != NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "bad index \"", bytes, - "\": must be integer or \"end\"", (char *) NULL); - } - return result; - } + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "invalid index \"", bytes, + "\": must be integer or ?end[+-]?expression", + (char *) NULL); + } + return TCL_ERROR; } - *indexPtr = index; return TCL_OK; } diff --git a/tests/cmdIL.test b/tests/cmdIL.test index ac39ec0..2f5d62e 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.6 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.7 1999/05/04 01:33:11 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -52,7 +52,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"}} +} {1 {syntax error in expression "foo"}} 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/cmdMZ.test b/tests/cmdMZ.test index 4cd72d2..c9ead57 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.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: cmdMZ.test,v 1.2 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.3 1999/05/04 01:33:11 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -159,14 +159,14 @@ test cmdMZ-5.1 {Tcl_StringObjCmd: error conditions} { } {1 {wrong # args: should be "string option arg ?arg ...?"}} test cmdMZ-5.2 {Tcl_StringObjCmd: error conditions} { list [catch {string gorp a b} msg] $msg -} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {bad option "gorp": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-6.1 {Tcl_StringObjCmd: string compare} { list [catch {string compare a} msg] $msg -} {1 {wrong # args: should be "string compare string1 string2"}} +} {1 {wrong # args: should be "string compare string1 string2 ?length?"}} test cmdMZ-6.2 {Tcl_StringObjCmd: string compare} { list [catch {string compare a b c} msg] $msg -} {1 {wrong # args: should be "string compare string1 string2"}} +} {1 {expected integer but got "c"}} test cmdMZ-6.3 {Tcl_StringObjCmd: string compare} { string compare abcde abdef } -1 @@ -237,12 +237,12 @@ test cmdMZ-8.2 {Tcl_StringObjCmd: string index} { } {1 {wrong # args: should be "string index string charIndex"}} test cmdMZ-8.3 {Tcl_StringObjCmd: string index} { list [catch {string index a xyz} msg] $msg -} {1 {expected integer but got "xyz"}} +} {1 {syntax error in expression "xyz"}} test cmdMZ-8.4 {Tcl_StringObjCmd: string index} { string index abcde 0 } a test cmdMZ-8.5 {Tcl_StringObjCmd: string index} { - string i abcde 4 + string in abcde 4 } e test cmdMZ-8.6 {Tcl_StringObjCmd: string index} { string index abcde 5 @@ -305,7 +305,7 @@ test cmdMZ-11.3 {Tcl_StringObjCmd: string match} { string match abc abc } 1 test cmdMZ-11.4 {Tcl_StringObjCmd: string match} { - string m abc abd + string mat abc abd } 0 test cmdMZ-12.1 {Tcl_StringObjCmd: string range} { @@ -319,10 +319,10 @@ test cmdMZ-12.3 {Tcl_StringObjCmd: string range} { } {1 {wrong # args: should be "string range string first last"}} test cmdMZ-12.4 {Tcl_StringObjCmd: string range} { list [catch {string range abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or "end"}} +} {1 {syntax error in expression "abc"}} test cmdMZ-12.5 {Tcl_StringObjCmd: string range} { list [catch {string range abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or "end"}} +} {1 {syntax error in expression "eof"}} test cmdMZ-12.6 {Tcl_StringObjCmd: string range, first < 0} { string range abcdefghijklmnop -3 2 } {abc} @@ -362,10 +362,10 @@ test cmdMZ-12.17 {Tcl_StringObjCmd: string range, unicode} { test cmdMZ-13.1 {Tcl_StringObjCmd: string tolower} { list [catch {string tolower} msg] $msg -} {1 {wrong # args: should be "string tolower string"}} +} {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test cmdMZ-13.2 {Tcl_StringObjCmd: string tolower} { list [catch {string tolower a b} msg] $msg -} {1 {wrong # args: should be "string tolower string"}} +} {1 {syntax error in expression "b"}} test cmdMZ-13.3 {Tcl_StringObjCmd: string tolower} { string tolower ABCDeF } {abcdef} @@ -381,10 +381,10 @@ test cmdMZ-13.6 {Tcl_StringObjCmd: string tolower, unicode} { test cmdMZ-14.1 {Tcl_StringObjCmd: string toupper} { list [catch {string toupper} msg] $msg -} {1 {wrong # args: should be "string toupper string"}} +} {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test cmdMZ-14.2 {Tcl_StringObjCmd: string toupper} { list [catch {string toupper a b} msg] $msg -} {1 {wrong # args: should be "string toupper string"}} +} {1 {syntax error in expression "b"}} test cmdMZ-14.3 {Tcl_StringObjCmd: string toupper} { string toupper abCDEf } {ABCDEF} @@ -400,10 +400,10 @@ test cmdMZ-14.6 {Tcl_StringObjCmd: string toupper, unicode} { test cmdMZ-15.1 {Tcl_StringObjCmd: string totitle} { list [catch {string totitle} msg] $msg -} {1 {wrong # args: should be "string totitle string"}} +} {1 {wrong # args: should be "string totitle string ?first? ?last?"}} test cmdMZ-15.2 {Tcl_StringObjCmd: string totitle} { list [catch {string totitle a b} msg] $msg -} {1 {wrong # args: should be "string totitle string"}} +} {1 {syntax error in expression "b"}} test cmdMZ-15.3 {Tcl_StringObjCmd: string totitle} { string totitle abCDEf } {Abcdef} @@ -478,7 +478,7 @@ test cmdMZ-18.4 {Tcl_StringObjCmd: string trimright errors} { } {1 {wrong # args: should be "string trimright string ?chars?"}} test cmdMZ-18.5 {Tcl_StringObjCmd: string trimright errors} { list [catch {string trimg a} msg] $msg -} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {bad option "trimg": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-19.1 {Tcl_StringObjCmd: string wordend} { list [catch {string wordend a} msg] $msg @@ -488,7 +488,7 @@ test cmdMZ-19.2 {Tcl_StringObjCmd: string wordend} { } {1 {wrong # args: should be "string wordend string index"}} test cmdMZ-19.3 {Tcl_StringObjCmd: string wordend} { list [catch {string wordend a gorp} msg] $msg -} {1 {expected integer but got "gorp"}} +} {1 {syntax error in expression "gorp"}} test cmdMZ-19.4 {Tcl_StringObjCmd: string wordend} { string wordend abc. -1 } 3 @@ -522,7 +522,7 @@ test cmdMZ-19.13 {Tcl_StringObjCmd: string wordend, unicode} { test cmdMZ-20.1 {Tcl_StringObjCmd: string wordstart} { list [catch {string word a} msg] $msg -} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {ambiguous option "word": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test cmdMZ-20.2 {Tcl_StringObjCmd: string wordstart} { list [catch {string wordstart a} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} @@ -531,7 +531,7 @@ test cmdMZ-20.3 {Tcl_StringObjCmd: string wordstart} { } {1 {wrong # args: should be "string wordstart string index"}} test cmdMZ-20.4 {Tcl_StringObjCmd: string wordstart} { list [catch {string wordstart a gorp} msg] $msg -} {1 {expected integer but got "gorp"}} +} {1 {syntax error in expression "gorp"}} test cmdMZ-20.5 {Tcl_StringObjCmd: string wordstart} { string wordstart "one two three_words" 400 } 8 diff --git a/tests/error.test b/tests/error.test index 45e8f1d..a4d311f 100644 --- a/tests/error.test +++ b/tests/error.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: error.test,v 1.3 1999/04/16 00:47:26 stanton Exp $ +# RCS: @(#) $Id: error.test,v 1.4 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -38,12 +38,12 @@ test error-1.1 {simple errors from commands} { test error-1.2 {simple errors from commands} { catch {format [string compare]} b set b -} {wrong # args: should be "string compare string1 string2"} +} {wrong # args: should be "string compare string1 string2 ?length?"} test error-1.3 {simple errors from commands} { catch {format [string compare]} b set errorInfo -} {wrong # args: should be "string compare string1 string2" +} {wrong # args: should be "string compare string1 string2 ?length?" while executing "string compare"} diff --git a/tests/lindex.test b/tests/lindex.test index c7e5fb8..ed79c31 100644 --- a/tests/lindex.test +++ b/tests/lindex.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: lindex.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: lindex.test,v 1.4 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -52,7 +52,7 @@ test lindex-2.2 {error conditions} { } {1 {wrong # args: should be "lindex list index"}} test lindex-2.3 {error conditions} { list [catch {lindex 1 2a2} msg] $msg -} {1 {bad index "2a2": must be integer or "end"}} +} {1 {syntax error in expression "2a2"}} test lindex-2.4 {error conditions} { list [catch {lindex "a \{" 2} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/linsert.test b/tests/linsert.test index 5c54d92..456ea3e 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.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: linsert.test,v 1.4 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -86,7 +86,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"}} +} {1 {syntax error in expression "12x"}} 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 4132969..4dc70f8 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.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: lrange.test,v 1.4 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -74,10 +74,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"}} +} {1 {syntax error in expression "b"}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg -} {1 {bad index "enigma": must be integer or "end"}} +} {1 {syntax error in expression "enigma"}} 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 d0743eb..b1f0657 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.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: lreplace.test,v 1.4 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -109,13 +109,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"}} +} {1 {syntax error in expression "a"}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer or "end"}} +} {1 {syntax error in expression "x"}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer or "end"}} +} {1 {syntax error in expression "1x"}} 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/string.test b/tests/string.test index 1648dc4..013cde4 100644 --- a/tests/string.test +++ b/tests/string.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: string.test,v 1.5 1999/04/30 16:22:25 hershey Exp $ +# RCS: @(#) $Id: string.test,v 1.6 1999/05/04 01:33:12 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -20,18 +20,27 @@ if {[lsearch [namespace children] ::tcltest] == -1} { test string-1.1 {string compare} { string compare abcde abdef } -1 -test string-1.2 {string compare} { +test string-1.2 {string compare, shortest method name} { string c abcde ABCDE } 1 test string-1.3 {string compare} { string compare abcde abcde } 0 -test string-1.4 {string compare} { +test string-1.4 {string compare too few args} { list [catch {string compare a} msg] $msg -} {1 {wrong # args: should be "string compare string1 string2"}} -test string-1.5 {string compare} { +} {1 {wrong # args: should be "string compare string1 string2 ?length?"}} +test string-1.5 {string compare bad args} { list [catch {string compare a b c} msg] $msg -} {1 {wrong # args: should be "string compare string1 string2"}} +} {1 {expected integer but got "c"}} +test string-1.6 {string compare too many args} { + list [catch {string compare a b 1 c} msg] $msg +} {1 {wrong # args: should be "string compare string1 string2 ?length?"}} +test string-1.7 {string compare with length} { + string compare abcde abxyz 2 +} 0 +test string-1.8 {string compare with special index} { + list [catch {string compare abcde abxyz end-3} msg] $msg +} {1 {expected integer but got "end-3"}} test string-2.1 {string first} { string first bq abcdefgbcefgbqrs @@ -59,7 +68,7 @@ test string-3.1 {string index} { string index abcde 0 } a test string-3.2 {string index} { - string i abcde 4 + string in abcde 4 } e test string-3.3 {string index} { string index abcde 5 @@ -75,7 +84,13 @@ test string-3.6 {string index} { } {1 {wrong # args: should be "string index string charIndex"}} test string-3.7 {string index} { list [catch {string index a xyz} msg] $msg -} {1 {expected integer but got "xyz"}} +} {1 {syntax error in expression "xyz"}} +test string-3.8 {string index} { + string index abc end +} c +test string-3.9 {string index} { + string index abc end-1 +} b test string-4.1 {string last} { string la xxx xxxx123xx345x678 @@ -110,7 +125,7 @@ test string-6.1 {string match} { string match abc abc } 1 test string-6.2 {string match} { - string m abc abd + string mat abc abd } 0 test string-6.3 {string match} { string match ab*c abc @@ -229,16 +244,19 @@ test string-7.11 {string range} { } {1 {wrong # args: should be "string range string first last"}} test string-7.12 {string range} { list [catch {string range abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or "end"}} +} {1 {syntax error in expression "abc"}} test string-7.13 {string range} { list [catch {string range abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or "end"}} +} {1 {syntax error in expression "eof"}} test string-7.14 {string range} { - string range abcdefghijklmnop end end -} {p} + string range abcdefghijklmnop end-1 end +} {op} test string-7.15 {string range} { string range abcdefghijklmnop e 1000 } {p} +test string-7.16 {string range} { + string range abcdefghijklmnop end end-1 +} {} test string-8.1 {string trim} { string trim " XYZ " @@ -292,7 +310,7 @@ test string-10.4 {string trimright errors} { } {1 {wrong # args: should be "string trimright string ?chars?"}} test string-10.5 {string trimright errors} { list [catch {string trimg a} msg] $msg -} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {bad option "trimg": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test string-11.1 {string tolower} { string tolower ABCDeF @@ -303,114 +321,295 @@ test string-11.2 {string tolower} { test string-11.3 {string tolower} { string tolower {123#$&*()} } {123#$&*()} -test string-11.4 {string tolower} { +test string-11.4 {string tolower too few args} { list [catch {string tolower} msg] $msg -} {1 {wrong # args: should be "string tolower string"}} -test string-11.5 {string tolower} { +} {1 {wrong # args: should be "string tolower string ?first? ?last?"}} +test string-11.5 {string tolower bad args} { list [catch {string tolower a b} msg] $msg -} {1 {wrong # args: should be "string tolower string"}} -test string-11.6 {string tolower called with badly formed Utf string} { +} {1 {syntax error in expression "b"}} +test string-11.6 {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?"}} +test string-11.7 {string tolower} { + string tolower ABC 1 +} AbC +test string-11.8 {string tolower} { + string tolower ABC 1 end +} Abc +test string-11.9 {string tolower} { + string tolower ABC 0 end-1 +} abC +test string-11.10 {string tolower called with badly formed Utf string} { string tolower [bytestring "\u00fcBER"] } [bytestring "\u00fcber"] -test string-11.7 {string totitle} { +test string-12.1 {string totitle} { string totitle ABCDeF } {Abcdef} -test string-11.8 {string totitle} { +test string-12.2 {string totitle} { string totitle "aBC d Hij xyZ" } {Abc d hij xyz} -test string-11.9 {string totitle} { +test string-12.3 {string totitle} { string totitle {123#$&*()} } {123#$&*()} -test string-11.10 {string totitle} { +test string-12.4 {string totitle} { list [catch {string totitle} msg] $msg -} {1 {wrong # args: should be "string totitle string"}} -test string-11.11 {string totitle} { +} {1 {wrong # args: should be "string totitle string ?first? ?last?"}} +test string-12.5 {string totitle} { list [catch {string totitle a b} msg] $msg -} {1 {wrong # args: should be "string totitle string"}} -test string-11.12 {string totitle called with badly formed Utf string} { +} {1 {syntax error in expression "b"}} +test string-12.6 {string totitle too many args} { + list [catch {string totitle ABC 1 end oops} msg] $msg +} {1 {wrong # args: should be "string totitle string ?first? ?last?"}} +test string-12.7 {string totitle} { + string totitle abC 1 +} aBC +test string-12.8 {string totitle} { + string totitle ABC 1 end +} ABc +test string-12.9 {string totitle} { + string totitle ABC 0 end-1 +} AbC +test string-12.10 {string totitle called with badly formed Utf string} { string totitle [bytestring "\u00fcBER"] } [bytestring "\u00fcber"] -test string-12.1 {string toupper} { +test string-13.1 {string toupper} { string toupper abCDEf } {ABCDEF} -test string-12.2 {string toupper} { +test string-13.2 {string toupper} { string toupper "abc xYz" } {ABC XYZ} -test string-12.3 {string toupper} { +test string-13.3 {string toupper} { string toupper {123#$&*()} } {123#$&*()} -test string-12.4 {string toupper} { +test string-13.4 {string toupper} { list [catch {string toupper} msg] $msg -} {1 {wrong # args: should be "string toupper string"}} -test string-12.5 {string toupper} { +} {1 {wrong # args: should be "string toupper string ?first? ?last?"}} +test string-13.5 {string toupper} { list [catch {string toupper a b} msg] $msg -} {1 {wrong # args: should be "string toupper string"}} -test string-12.6 {string toupper called with badly formed Utf string} { +} {1 {syntax error in expression "b"}} +test string-13.6 {string toupper} { + list [catch {string toupper a 1 end oops} msg] $msg +} {1 {wrong # args: should be "string toupper string ?first? ?last?"}} +test string-13.7 {string toupper} { + string toupper abc 1 +} aBc +test string-13.8 {string toupper} { + string toupper abc 1 end +} aBC +test string-13.9 {string toupper} { + string toupper abc 0 end-1 +} ABc +test string-13.10 {string toupper called with badly formed Utf string} { string toupper [bytestring "\u00fcber"] } [bytestring "\u00fcBER"] -test string-13.1 {string wordend} { +test string-14.1 {string wordend} { list [catch {string wordend a} msg] $msg } {1 {wrong # args: should be "string wordend string index"}} -test string-13.2 {string wordend} { +test string-14.2 {string wordend} { list [catch {string wordend a b c} msg] $msg } {1 {wrong # args: should be "string wordend string index"}} -test string-13.3 {string wordend} { +test string-14.3 {string wordend} { list [catch {string wordend a gorp} msg] $msg -} {1 {expected integer but got "gorp"}} -test string-13.4 {string wordend} { +} {1 {syntax error in expression "gorp"}} +test string-14.4 {string wordend} { string wordend abc. -1 } 3 -test string-13.5 {string wordend} { +test string-14.5 {string wordend} { string wordend abc. 100 } 4 -test string-13.6 {string wordend} { +test string-14.6 {string wordend} { string wordend "word_one two three" 2 } 8 -test string-13.7 {string wordend} { +test string-14.7 {string wordend} { string wordend "one .&# three" 5 } 6 -test string-13.8 {string wordend} { +test string-14.8 {string wordend} { string worde "x.y" 0 } 1 +test string-14.9 {string wordend} { + string worde "x.y" end-1 +} 2 -test string-14.1 {string wordstart} { +test string-15.1 {string wordstart} { list [catch {string word a} msg] $msg -} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} -test string-14.2 {string wordstart} { +} {1 {ambiguous option "word": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +test string-15.2 {string wordstart} { list [catch {string wordstart a} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} -test string-14.3 {string wordstart} { +test string-15.3 {string wordstart} { list [catch {string wordstart a b c} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} -test string-14.4 {string wordstart} { +test string-15.4 {string wordstart} { list [catch {string wordstart a gorp} msg] $msg -} {1 {expected integer but got "gorp"}} -test string-14.5 {string wordstart} { +} {1 {syntax error in expression "gorp"}} +test string-15.5 {string wordstart} { string wordstart "one two three_words" 400 } 8 -test string-14.6 {string wordstart} { +test string-15.6 {string wordstart} { string wordstart "one two three_words" 2 } 0 -test string-14.7 {string wordend} { +test string-15.7 {string wordstart} { string wordstart "one two three_words" -2 } 0 -test string-14.8 {string wordend} { +test string-15.8 {string wordstart} { string wordstart "one .*&^ three" 6 } 6 -test string-14.9 {string wordend} { +test string-15.9 {string wordstart} { string wordstart "one two three" 4 } 4 +test string-15.10 {string wordstart} { + string wordstart "one two three" end-5 +} 7 -test string-15.1 {error conditions} { +test string-16.1 {error conditions} { list [catch {string gorp a b} msg] $msg -} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} -test string-15.2 {error conditions} { +} {1 {bad option "gorp": must be bytes, compare, equal, first, icompare, iequal, index, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} +test string-16.2 {error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}} +# only need a few tests on equal, since it uses the same code as +# string compare, but just modifies the return output +test string-17.1 {string equal} { + string equal abcde abdef +} 0 +test string-17.2 {string equal} { + string eq abcde ABCDE +} 0 +test string-17.3 {string equal} { + string equal abcde abcde +} 1 + +test string-18.1 {string icompare} { + string icompare abcde abdef +} -1 +test string-18.2 {string icompare} { + string ic abcde ABCDE +} 0 +test string-18.3 {string icompare} { + string icompare abcde abcde +} 0 +test string-18.4 {string icompare too few args} { + list [catch {string icompare a} msg] $msg +} {1 {wrong # args: should be "string icompare string1 string2 ?length?"}} +test string-18.5 {string icompare bad args} { + list [catch {string icompare a b c} msg] $msg +} {1 {expected integer but got "c"}} +test string-18.6 {string icompare too many args} { + list [catch {string icompare a b 1 c} msg] $msg +} {1 {wrong # args: should be "string icompare string1 string2 ?length?"}} +test string-18.7 {string icompare with length} { + string icompare abcde Abxyz 2 +} 0 +test string-18.8 {string icompare with special index} { + list [catch {string icompare Abcde abxyz end-3} msg] $msg +} {1 {expected integer but got "end-3"}} + +test string-19.1 {string iequal} { + string iequal abcde abdef +} 0 +test string-19.2 {string iequal} { + string ieq abcde ABCDE +} 1 +test string-19.3 {string iequal} { + string iequal abcde abcde +} 1 + +test string-20.1 {string map} { + list [catch {string map} msg] $msg +} {1 {wrong # args: should be "string map charMap string"}} +test string-20.2 {string map} { + list [catch {string map {a b} abba oops} msg] $msg +} {1 {wrong # args: should be "string map charMap string"}} +test string-20.3 {string map} { + string map {a b} abba +} {bbbb} +test string-20.4 {string map} { + string map {abc 321 ab * a A} aabcabaababcab +} {A321*A*321*} +test string-20.5 {string map} { + list [catch {string map {a b c} abba} msg] $msg +} {1 {char map list unbalanced}} +test string-20.6 {string map} { + string map {\x00 NULL blah \x00nix} {qwerty} +} {qwerty} + +test string-21.1 {string repeat} { + list [catch {string repeat} msg] $msg +} {1 {wrong # args: should be "string repeat string count"}} +test string-21.2 {string repeat} { + list [catch {string repeat abc 10 oops} msg] $msg +} {1 {wrong # args: should be "string repeat string count"}} +test string-21.3 {string repeat} { + string repeat {} 100 +} {} +test string-21.4 {string repeat} { + string repeat { } 5 +} { } +test string-21.5 {string repeat} { + string repeat abc 3 +} {abcabcabc} +test string-21.6 {string repeat} { + string repeat abc -1 +} {} +test string-21.7 {string repeat} { + list [catch {string repeat abc end} msg] $msg +} {1 {expected integer but got "end"}} + +test string-22.1 {string replace} { +} {} +test string-22.2 {string replace} { + string replace abcdefghijklmnop 2 14 +} {abp} +test string-22.3 {string replace} { + string replace abcdefghijklmnop 7 1000 +} {abcdefg} +test string-22.4 {string replace} { + string replace abcdefghijklmnop 10 e +} {abcdefghij} +test string-22.5 {string replace} { + string replace abcdefghijklmnop 10 9 +} {abcdefghijklmnop} +test string-22.6 {string replace} { + string replace abcdefghijklmnop -3 2 +} {defghijklmnop} +test string-22.7 {string replace} { + string replace abcdefghijklmnop -3 -2 +} {abcdefghijklmnop} +test string-22.8 {string replace} { + string replace abcdefghijklmnop 1000 1010 +} {abcdefghijklmnop} +test string-22.9 {string replace} { + string replace abcdefghijklmnop -100 end +} {} +test string-22.10 {string replace} { + list [catch {string replace} msg] $msg +} {1 {wrong # args: should be "string replace string first last ?string?"}} +test string-22.11 {string replace} { + list [catch {string replace a 1} msg] $msg +} {1 {wrong # args: should be "string replace string first last ?string?"}} +test string-22.12 {string replace} { + list [catch {string replace a 1 2 3 4} msg] $msg +} {1 {wrong # args: should be "string replace string first last ?string?"}} +test string-22.13 {string replace} { + list [catch {string replace abc abc 1} msg] $msg +} {1 {syntax error in expression "abc"}} +test string-22.14 {string replace} { + list [catch {string replace abc 1 eof} msg] $msg +} {1 {syntax error in expression "eof"}} +test string-22.15 {string replace} { + string replace abcdefghijklmnop end-10 end-2 NEW +} {abcdeNEWop} +test string-22.16 {string replace} { + string replace abcdefghijklmnop 0 e foo +} {foo} +test string-22.17 {string replace} { + string replace abcdefghijklmnop end end-1 +} {abcdefghijklmnop} + # cleanup ::tcltest::cleanupTests return @@ -426,3 +625,6 @@ return + + + -- cgit v0.12