* 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]:

2 files changed, 331 insertions, 71 deletions

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;
 }