merge 8.7

Remove the updateStringProc that can never be called.

doc/StringObj.3

@@ -8,7 +8,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
+Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj, Tcl_ReplaceObj \- manipulate Tcl values as strings
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -84,8 +84,13 @@ int
 .sp
 Tcl_Obj *
 \fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ReplaceObj\fR(\fIinterp, objPtr, startIndex, removeCount, insertObjPtr\fR)
 .SH ARGUMENTS
 .AS "const Tcl_UniChar" *appendObjPtr in/out
+.AP Tcl_Interp *interp in
+If non-NULL, interpreter in which error result messages are stored.
 .AP "const char" *bytes in
 Points to the first byte of an array of UTF-8-encoded bytes
 used to set or append to a string value.
@@ -143,6 +148,12 @@ The array of values to format or concatenate.
 .AP int newLength in
 New length for the string value of \fIobjPtr\fR, not including the
 final null character.
+.AP int startIndex in
+The index of the first character to insert, replace, or remove.
+.AP int removeCount in
+The number of characters to replace or remove.
+.AP Tcl_Obj *insertObjPtr in/out
+The value to insert or replace.  If NULL, interpreted as empty string.
 .BE
 .SH DESCRIPTION
 .PP
@@ -380,6 +391,37 @@ white space, then that value is ignored entirely. This white-space
 removal was added to make the output of the \fBconcat\fR command
 cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
 newly-created value whose ref count is zero.
+.PP
+\fBTcl_ReplaceObj\fR inserts, replaces, or removes a substring in \fIobjPtr\fR
+and returns a pointer to the new or updated string object.
+If \fIobjPtr\fR or \fIinsertObjPtr\fR are unshared, one of them will be modified
+in place, and its address will be returned.
+If this optimization is unavailable, a new string object will be allocated to
+store the result, its address will be returned, and neither \fIobjPtr\fR nor
+\fIinsertObjPtr\fR will be modified.
+Should a memory allocation error occur, \fBTcl_ReplaceObj\fR returns NULL and
+(if \fIinterp\fR is non-NULL) places error information in the result value of
+\fIinterp\fR.
+.PP
+The choice of operation performed by \fBTcl_ReplaceObj\fR is determined by
+\fIremoveCount\fR and the length of \fIinsertObjPtr\fR.
+To insert, \fIremoveCount\fR is zero, and \fIinsertObjPtr\fR is the insertion
+substring.
+To replace, \fIremoveCount\fR is the number of characters to replace, and
+\fIinsertObjPtr\fR is the replacement substring.
+To remove, \fIremoveCount\fR is the number of characters to remove, and
+\fIinsertObjPtr\fR is NULL or empty string.
+.PP
+\fIstartIndex\fR is the index of the first character in \fIobjPtr\fR to insert,
+replace, or remove.
+Negative \fIstartIndex\fR is taken to be zero, and large \fIstartIndex\fR is
+automatically limited to be no greater than the length of \fIobjPtr\fR.
+In a similar manner, negative \fIremoveCount\fR is taken to be zero, and large
+\fIremoveCount\fR is automatically limited such that the sum of \fIstartIndex\fR
+and \fIremoveCount\fR is no greater than the length of \fIobjPtr\fR.
+Consequently, if \fIstartIndex\fR is at the end of \fIobjPtr\fR,
+\fIinsertObjPtr\fR will be appended to \fIobjPtr\fR, and \fIremoveCount\fR will
+be ignored.
 .SH "SEE ALSO"
 Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3)
 .SH KEYWORDS

doc/string.n

@@ -89,6 +89,23 @@ If \fIcharIndex\fR is less than 0 or greater than or equal to the
 length of the string then this command returns an empty string.
 .RE
 .TP
+\fBstring insert \fIstring index insertString\fR
+.
+Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
+\fIindex\fR'th character.  \fIindex\fR may be specified as described in the
+\fBSTRING INDICES\fR section.
+.RS
+.PP
+If \fIindex\fR is start-relative, the first character inserted in the returned
+string will be at the specified index.  If \fIindex\fR is end-relative, the last
+character inserted in the returned string will be at the specified index.
+.PP
+If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
+\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR.  If \fIindex\fR is at
+or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
+\fIinsertString\fR is appended to \fIstring\fR.
+.RE
+.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

generic/tcl.decls

@@ -2332,7 +2332,11 @@ declare 631 {
 
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
-
+# TIP #475
+declare 632 {
+    Tcl_Obj *Tcl_ReplaceObj(Tcl_Interp *interp, Tcl_Obj *strObj, int startIndex,
+	    int removeCount, Tcl_Obj *insObj)
+}
 
 ##############################################################################
 

generic/tclAssembly.c

@@ -477,6 +477,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
     {"strreplace",	ASSEM_1BYTE,	INST_STR_REPLACE,	4,	1},
+    {"strinsert",	ASSEM_1BYTE,	INST_STR_INSERT,	3,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
     {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
     {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
@@ -524,10 +525,10 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
     INST_RESOLVE_COMMAND,					/* 154 */
-    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
-    INST_CONCAT_STK,						/* 169 */
-    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE,		/* 170-172 */
-    INST_NUM_TYPE						/* 180 */
+    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 170-172 */
+    INST_CONCAT_STK,						/* 173 */
+    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE,		/* 174-176 */
+    INST_NUM_TYPE						/* 183 */
 };
 
 /*

generic/tclBinary.c

@@ -1017,7 +1017,7 @@ BinaryFormatCmd(
     }
 
     /*
-     * Prepare the result object by preallocating the caclulated number of
+     * Prepare the result object by preallocating the calculated number of
      * bytes and filling with nulls.
      */
 

generic/tclCmdMZ.c

@@ -1449,6 +1449,53 @@ StringIndexCmd(
     return TCL_OK;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringInsertCmd --
+ *
+ *	This procedure is invoked to process the "string insert" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringInsertCmd(
+    ClientData dummy,		/* Not used */
+    Tcl_Interp *interp,		/* Current interpreter */
+    int objc,			/* Number of arguments */
+    Tcl_Obj *const objv[])	/* Argument objects */
+{
+    int length;			/* String length */
+    int index;			/* Insert index */
+    Tcl_Obj *outObj;		/* Output object */
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
+	return TCL_ERROR;
+    }
+
+    length = Tcl_GetCharLength(objv[1]);
+    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (!(outObj = Tcl_ReplaceObj(interp, objv[1], index, 0, objv[3]))) {
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, outObj);
+    return TCL_OK;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1572,11 +1619,11 @@ StringIsCmd(
 		string1 = TclGetStringFromObj(objPtr, &length1);
 		result = length1 == 0;
 	    }
-	} else if (((index == STR_IS_TRUE) &&
-		objPtr->internalRep.longValue == 0)
-	    || ((index == STR_IS_FALSE) &&
-		objPtr->internalRep.longValue != 0)) {
-	    result = 0;
+	} else if (index != STR_IS_BOOL) {
+	    TclGetBooleanFromObj(NULL, objPtr, &i);
+	    if ((index == STR_IS_TRUE) ^ i) {
+		result = 0;
+	    }
 	}
 	break;
     case STR_IS_CONTROL:
@@ -2305,44 +2352,43 @@ StringRplcCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_UniChar *ustring;
-    int first, last, length;
+    int first, last, length;	/* Replacement indexes and string length */
+    Tcl_Obj *strObj;		/* String being modified */
+    Tcl_Obj *insObj;		/* Substring to insert, may be NULL */
+    Tcl_Obj *outObj;		/* Output object */
 
     if (objc < 4 || objc > 5) {
 	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
 	return TCL_ERROR;
     }
 
-    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
-    length--;
-
-    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
-	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
+    strObj = objv[1];
+    length = Tcl_GetCharLength(strObj) - 1;
+    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK
+     || TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    if ((last < first) || (last < 0) || (first > length)) {
-	Tcl_SetObjResult(interp, objv[1]);
-    } else {
-	Tcl_Obj *resultPtr;
-
-	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
-	length--;
-
-	if (first < 0) {
-	    first = 0;
-	}
-
-	resultPtr = Tcl_NewUnicodeObj(ustring, first);
-	if (objc == 5) {
-	    Tcl_AppendObjToObj(resultPtr, objv[4]);
-	}
-	if (last < length) {
-	    Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
-		    length - last);
-	}
-	Tcl_SetObjResult(interp, resultPtr);
+    if (first < 0) {
+	first = 0;
     }
+
+    if (last >= first) {
+	if (objc == 5) {
+	    insObj = objv[4];
+	} else {
+	    insObj = NULL;
+	}
+
+	if (!(outObj = Tcl_ReplaceObj(interp, strObj, first,
+		last - first + 1, insObj))) {
+	    return TCL_ERROR;
+	}
+    } else {
+	outObj = strObj;
+    }
+
+    Tcl_SetObjResult(interp, outObj);
     return TCL_OK;
 }
 
@@ -3344,6 +3390,7 @@ TclInitStringCmd(
 	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
 	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
 	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
+	{"insert",      StringInsertCmd,TclCompileStringInsertCmd, NULL, NULL, 0},
 	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
 	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
 	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},

generic/tclCompCmdsSZ.c

@@ -500,6 +500,55 @@ TclCompileStringIndexCmd(
     return TCL_OK;
 }
 
+int
+TclCompileStringInsertCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *valueTokenPtr, *indexTokenPtr, *insertionTokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int idx;
+
+    if (parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    indexTokenPtr = TokenAfter(valueTokenPtr);
+    insertionTokenPtr = TokenAfter(indexTokenPtr);
+
+    if (GetIndexFromToken(indexTokenPtr, &idx) != TCL_OK
+     || (idx && idx != INDEX_END)) {
+	/*
+	 * General case: handle non-constant and interior indices at runtime.
+	 */
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	CompileWord(envPtr, indexTokenPtr, interp, 2);
+	CompileWord(envPtr, insertionTokenPtr, interp, 3);
+	OP(STR_INSERT);
+    } else {
+	/*
+	 * Special case: prepending and appending.
+	 */
+
+	if (!idx) {
+	    CompileWord(envPtr, insertionTokenPtr, interp, 3);
+	    CompileWord(envPtr, valueTokenPtr, interp, 1);
+	} else {
+	    CompileWord(envPtr, valueTokenPtr, interp, 1);
+	    CompileWord(envPtr, insertionTokenPtr, interp, 3);
+	}
+	OP1(STR_CONCAT1, 2);
+    }
+
+    return TCL_OK;
+}
+
 int
 TclCompileStringIsCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */

generic/tclCompile.c

@@ -659,6 +659,10 @@ InstructionDesc const tclInstructionTable[] = {
 	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
 	 * Stack: ... => ... time */
 
+    {"strinsert",	 1,	-2,	  0,	{OPERAND_NONE}},
+	/* [string insert] core: inserts a string into another.
+	 * Stack: ... string index insertString => ... newString */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 

generic/tclCompile.h

@@ -823,8 +823,10 @@ typedef struct ByteCode {
 
 #define INST_CLOCK_READ			189
 
+#define INST_STR_INSERT			190
+
 /* The last opcode */
-#define LAST_INST_OPCODE		189
+#define LAST_INST_OPCODE		190
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying

generic/tclDecls.h

@@ -1838,6 +1838,10 @@ EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
 				unsigned int flags,
 				Tcl_TcpAcceptProc *acceptProc,
 				ClientData callbackData);
+/* 632 */
+EXTERN Tcl_Obj *	Tcl_ReplaceObj(Tcl_Interp *interp, Tcl_Obj *strObj,
+				int startIndex, int removeCount,
+				Tcl_Obj *insObj);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2505,6 +2509,7 @@ typedef struct TclStubs {
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
     Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
+    Tcl_Obj * (*tcl_ReplaceObj) (Tcl_Interp *interp, Tcl_Obj *strObj, int startIndex, int removeCount, Tcl_Obj *insObj); /* 632 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3799,6 +3804,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
 #define Tcl_OpenTcpServerEx \
 	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
+#define Tcl_ReplaceObj \
+	(tclStubsPtr->tcl_ReplaceObj) /* 632 */
 
 #endif /* defined(USE_TCL_STUBS) */
 

generic/tclDisassemble.c

@@ -817,17 +817,17 @@ static void
 UpdateStringOfInstName(
     Tcl_Obj *objPtr)
 {
-    int inst = (int)objPtr->internalRep.wideValue;
-    char *s, buf[20];
-    int len;
+    size_t len, inst = (size_t)objPtr->internalRep.wideValue;
+    char *s, buf[TCL_INTEGER_SPACE + 5];
 
-    if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
-        sprintf(buf, "inst_%d", inst);
+    if (inst > LAST_INST_OPCODE) {
+        sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
         s = buf;
     } else {
         s = (char *) tclInstructionTable[inst].name;
     }
     len = strlen(s);
+    /* assert (len < UINT_MAX) */
     objPtr->bytes = ckalloc(len + 1);
     memcpy(objPtr->bytes, s, len + 1);
     objPtr->length = len;

generic/tclExecute.c

@@ -513,21 +513,6 @@ VarHashCreateVar(
 	? TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 
-/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- *			int *boolPtr);
- */
-
-#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
-    (((objPtr)->typePtr == &tclIntType)			\
-	? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
-	: ((objPtr)->typePtr == &tclBooleanType)			\
-	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
-	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
-
 /*
  * Macro used to make the check for type overflow more mnemonic. This works by
  * comparing sign bits; the rest of the word is irrelevant. The ANSI C
@@ -5421,113 +5406,56 @@ TEBCresume(
 	(void) POP_OBJECT();
 	TclDecrRefCount(OBJ_AT_TOS);
 	(void) POP_OBJECT();
+
 	if (fromIdx < 0) {
 	    fromIdx = 0;
 	}
 
-	if (fromIdx > toIdx || fromIdx > length) {
-	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
-	    TclDecrRefCount(value3Ptr);
-	    NEXT_INST_F(1, 0, 0);
-	}
-
-	if (toIdx > length) {
-	    toIdx = length;
-	}
-
-	if (fromIdx == 0 && toIdx == length) {
-	    TclDecrRefCount(OBJ_AT_TOS);
-	    OBJ_AT_TOS = value3Ptr;
-	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
-	    NEXT_INST_F(1, 0, 0);
-	}
-
-	length3 = Tcl_GetCharLength(value3Ptr);
-
-	/*
-	 * See if we can splice in place. This happens when the number of
-	 * characters being replaced is the same as the number of characters
-	 * in the string to be inserted.
-	 */
-
-	if (length3 - 1 == toIdx - fromIdx) {
-	    unsigned char *bytes1, *bytes2;
-
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_DuplicateObj(valuePtr);
-	    } else {
-		objResultPtr = valuePtr;
-	    }
-	    if (TclIsPureByteArray(objResultPtr)
-		    && TclIsPureByteArray(value3Ptr)) {
-		bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
-		bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
-		memcpy(bytes1 + fromIdx, bytes2, length3);
-	    } else {
-		ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
-		ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
-		memcpy(ustring1 + fromIdx, ustring2,
-			length3 * sizeof(Tcl_UniChar));
-	    }
-	    Tcl_InvalidateStringRep(objResultPtr);
-	    TclDecrRefCount(value3Ptr);
-	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
-	    if (objResultPtr == valuePtr) {
-		NEXT_INST_F(1, 0, 0);
-	    } else {
-		NEXT_INST_F(1, 1, 1);
+	if (fromIdx <= toIdx && fromIdx <= length) {
+	    value2Ptr = Tcl_ReplaceObj(interp, valuePtr, fromIdx,
+		    toIdx - fromIdx + 1, value3Ptr);
+	    if (!value2Ptr) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    } else if (valuePtr != value2Ptr) {
+		(void) POP_OBJECT();
+		PUSH_OBJECT(value2Ptr);
+		TclDecrRefCount(valuePtr);
 	    }
 	}
 
-	/*
-	 * Get the unicode representation; this is where we guarantee to lose
-	 * bytearrays.
-	 */
-
-	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
-	length--;
-
-	/*
-	 * Remove substring using copying.
-	 */
-
-	objResultPtr = NULL;
-	if (fromIdx > 0) {
-	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
-	}
-	if (length3 > 0) {
-	    if (objResultPtr) {
-		Tcl_AppendObjToObj(objResultPtr, value3Ptr);
-	    } else if (Tcl_IsShared(value3Ptr)) {
-		objResultPtr = Tcl_DuplicateObj(value3Ptr);
-	    } else {
-		objResultPtr = value3Ptr;
-	    }
-	}
-	if (toIdx < length) {
-	    if (objResultPtr) {
-		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
-			length - toIdx);
-	    } else {
-		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
-			length - toIdx);
-	    }
-	}
-	if (objResultPtr == NULL) {
-	    /* This has to be the case [string replace $s 0 end {}] */
-	    /* which has result {} which is same as value3Ptr. */
-	    objResultPtr = value3Ptr;
-	}
-	if (objResultPtr == value3Ptr) {
-	    /* See [Bug 82e7f67325] */
-	    TclDecrRefCount(OBJ_AT_TOS);
-	    OBJ_AT_TOS = value3Ptr;
-	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
-	    NEXT_INST_F(1, 0, 0);
-	}
+	TRACE_APPEND(("\"%.30s\"\n", O2S(value2Ptr)));
 	TclDecrRefCount(value3Ptr);
-	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 1, 1);
+	NEXT_INST_F(1, 0, 0);
+
+    case INST_STR_INSERT:
+	value3Ptr = POP_OBJECT();	/* Argument #3: insertString. */
+	value2Ptr = POP_OBJECT();	/* Argument #2: index. */
+	valuePtr = OBJ_AT_TOS;		/* Argument #1: string. */
+	length = Tcl_GetCharLength(valuePtr);
+	TRACE(("\"%.20s\" %s \"%.20s\" => ", O2S(valuePtr),
+		O2S(value2Ptr), O2S(value3Ptr)));
+	if (TclGetIntForIndexM(interp, value2Ptr, length, &fromIdx) != TCL_OK) {
+	    TclDecrRefCount(value3Ptr);
+	    TclDecrRefCount(value2Ptr);
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TclDecrRefCount(value2Ptr);
+
+	value2Ptr = Tcl_ReplaceObj(interp, valuePtr, fromIdx, 0, value3Ptr);
+	if (!value2Ptr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	} else if (valuePtr != value2Ptr) {
+	    (void) POP_OBJECT();
+	    PUSH_OBJECT(value2Ptr);
+	    TclDecrRefCount(valuePtr);
+	}
+
+	TRACE_APPEND(("\"%.30s\"\n", O2S(value2Ptr)));
+	TclDecrRefCount(value3Ptr);
+	NEXT_INST_F(1, 0, 0);
 
     case INST_STR_MAP:
 	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
@@ -6484,7 +6412,8 @@ TEBCresume(
 	Var *iterVarPtr, *listVarPtr;
 	Tcl_Obj *oldValuePtr, *listPtr, **elements;
 	ForeachVarList *varListPtr;
-	int numLists, iterNum, listTmpIndex, listLen, numVars;
+	int numLists, listTmpIndex, listLen, numVars;
+	size_t iterNum;
 	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
 	long i;
 
@@ -6538,7 +6467,7 @@ TEBCresume(
 
 	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
 	valuePtr = iterVarPtr->value.objPtr;
-	iterNum = (int)valuePtr->internalRep.wideValue + 1;
+	iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
 	TclSetIntObj(valuePtr, iterNum);
 
 	/*
@@ -6559,7 +6488,7 @@ TEBCresume(
 			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
 		goto gotError;
 	    }
-	    if (listLen > iterNum * numVars) {
+	    if ((size_t)listLen > iterNum * numVars) {
 		continueLoop = 1;
 	    }
 	    listTmpIndex++;
@@ -6625,7 +6554,7 @@ TEBCresume(
 		listTmpIndex++;
 	    }
 	}
-	TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+	TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
 		numLists, iterNum, (continueLoop? "continue" : "exit")));
 
 	/*
@@ -6646,8 +6575,9 @@ TEBCresume(
 	ForeachInfo *infoPtr;
 	Tcl_Obj *listPtr, **elements, *tmpPtr;
 	ForeachVarList *varListPtr;
-	int numLists, iterMax, listLen, numVars;
-	int iterTmp, iterNum, listTmpDepth;
+	int numLists, listLen, numVars;
+	int listTmpDepth;
+	size_t iterNum, iterMax, iterTmp;
 	int varIndex, valIndex, j;
 	long i;
 
@@ -6698,8 +6628,8 @@ TEBCresume(
 	 */
 
 	TclNewObj(tmpPtr);
-	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
-	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
 
 	/*
@@ -6731,8 +6661,8 @@ TEBCresume(
 	TRACE(("=> "));
 
 	tmpPtr = OBJ_AT_DEPTH(1);
-	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
-	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
+	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;
 
 	/*
 	 * If some list still has a remaining list element iterate one more
@@ -6744,7 +6674,7 @@ TEBCresume(
 	     * Set the variables and jump back to run the body
 	     */
 
-	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
 
 	    listTmpDepth = numLists + 1;
 

generic/tclGet.c

@@ -142,7 +142,7 @@ Tcl_GetBoolean(
 	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
     if (code == TCL_OK) {
-	*boolPtr = (int)obj.internalRep.wideValue;
+	TclGetBooleanFromObj(NULL, &obj, boolPtr);
     }
     return code;
 }

generic/tclInt.h

@@ -2447,12 +2447,20 @@ typedef struct List {
 #define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */
 
 /*
- * Macros providing a faster path to integers: Tcl_GetLongFromObj,
- * Tcl_GetIntFromObj and TclGetIntForIndex.
+ * Macros providing a faster path to booleans and integers:
+ * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
+ * and TclGetIntForIndex.
  *
  * WARNING: these macros eval their args more than once.
  */
 
+#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
+    (((objPtr)->typePtr == &tclIntType)			\
+	? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
+	: ((objPtr)->typePtr == &tclBooleanType)			\
+	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
+	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
+
 #ifdef TCL_WIDE_INT_IS_LONG
 #define TclGetLongFromObj(interp, objPtr, longPtr) \
     (((objPtr)->typePtr == &tclIntType)	\
@@ -3731,6 +3739,9 @@ MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringInsertCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);

generic/tclObj.c

@@ -400,7 +400,6 @@ TclInitObjSubsystem(void)
 
     Tcl_RegisterObjType(&tclByteArrayType);
     Tcl_RegisterObjType(&tclDoubleType);
-    Tcl_RegisterObjType(&tclEndOffsetType);
     Tcl_RegisterObjType(&tclStringType);
     Tcl_RegisterObjType(&tclListType);
     Tcl_RegisterObjType(&tclDictType);
@@ -1899,7 +1898,7 @@ Tcl_GetBooleanFromObj(
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclBooleanType) {
-	    *boolPtr = (int) objPtr->internalRep.longValue;
+	    *boolPtr = objPtr->internalRep.longValue != 0;
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclDoubleType) {
@@ -1943,7 +1942,12 @@ Tcl_GetBooleanFromObj(
  *
  * Side effects:
  *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
- *	representation and the type of "objPtr" is set to boolean.
+ *	representation and the type of "objPtr" is set to boolean or int/wideInt.
+ *
+ *  Warning: If the returned type is "wideInt" (32-bit platforms) and your
+ *  platform is bigendian, you cannot use internalRep.longValue to distinguish
+ *  between false and true. On Windows and most other platforms this still will
+ *  work fine, but basically it is non-portable.
  *
  *----------------------------------------------------------------------
  */
@@ -1961,8 +1965,7 @@ TclSetBooleanFromAny(
 
     if (objPtr->bytes == NULL) {
 	if (objPtr->typePtr == &tclIntType) {
-	    switch (objPtr->internalRep.wideValue) {
-	    case 0L: case 1L:
+	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
 		return TCL_OK;
 	    }
 	    goto badBoolean;

generic/tclStringObj.c

@@ -481,8 +481,7 @@ Tcl_GetUniChar(
 
     /*
      * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the indexing operation.
+     * we don't need to convert to a string to perform the indexing operation.
      */
 
     if (TclIsPureByteArray(objPtr)) {
@@ -615,8 +614,7 @@ Tcl_GetRange(
 
     /*
      * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the substring operation.
+     * we don't need to convert to a string to perform the substring operation.
      */
 
     if (TclIsPureByteArray(objPtr)) {
@@ -1224,9 +1222,9 @@ Tcl_AppendObjToObj(
 
     /*
      * Handle append of one bytearray object to another as a special case.
-     * Note that we only do this when the objects don't have string reps; if
-     * it did, then appending the byte arrays together could well lose
-     * information; this is a special-case optimization only.
+     * Note that we only do this when the objects are pure so that the
+     * bytearray faithfully represent the true value; Otherwise
+     * appending the byte arrays together could lose information;
      */
 
     if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
@@ -2915,7 +2913,9 @@ TclStringCat(
     do {
 	Tcl_Obj *objPtr = *ov++;
 
-	if (objPtr->bytes) {
+	if (TclIsPureByteArray(objPtr)) {
+	    allowUniChar = 0;
+	} else if (objPtr->bytes) {
 	    /* Value has a string rep. */
 	    if (objPtr->length) {
 		/*
@@ -2930,17 +2930,13 @@ TclStringCat(
 	    }
 	} else {
 	    /* assert (objPtr->typePtr != NULL) -- stork! */
-	    if (TclIsPureByteArray(objPtr)) {
-		allowUniChar = 0;
+	    binary = 0;
+	    if (objPtr->typePtr == &tclStringType) {
+		/* Have a pure Unicode value; ask to preserve it */
+		requestUniChar = 1;
 	    } else {
-		binary = 0;
-		if (objPtr->typePtr == &tclStringType) {
-		    /* Have a pure Unicode value; ask to preserve it */
-		    requestUniChar = 1;
-		} else {
-		    /* Have another type; prevent shimmer */
-		    allowUniChar = 0;
-		}
+		/* Have another type; prevent shimmer */
+		allowUniChar = 0;
 	    }
 	}
     } while (--oc && (binary || allowUniChar));
@@ -3316,6 +3312,334 @@ TclStringFirst(
     }
 }
 
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_ReplaceObj --
+ *
+ *	Inserts, replaces, or removes characters in a string object.  To insert,
+ *	let removeCount be zero.  To replace or remove, let removeCount be
+ *	nonzero.  To remove, let insObj be empty string or NULL.
+ *
+ *	This function is used to implement [string insert] and [string replace].
+ *	However, unlike this function, [string replace] cannot be used to insert
+ *	a substring without replacing at least one character in the original.
+ *
+ * Results:
+ *	Removes removeCount characters from strObj starting at startIndex and
+ *	inserts insObj at that same location.  removeCount may be 0 to insert
+ *	without removing, and insObj may be NULL or empty string to remove
+ *	without inserting.
+ *
+ *	On success, returns a pointer to the updated string object.  If the
+ *	string object was modified in place, the return value is equal to strObj
+ *	or insObj, whichever was found to be unshared.  If this optimization
+ *	could not be performed, a new string object is allocated and its pointer
+ *	is returned.  On memory allocation failure, returns NULL and places
+ *	error information in the interpreter result.
+ *
+ * Side effects:
+ *	strObj and insObj may have their Tcl_ObjType changed to tclStringType or
+ *	properByteArrayType, and either one's value may be modified if unshared.
+ *
+ * TODO:
+ *	Memory allocation failure is only checked when concatenating shared,
+ *	non-pure byte array, non-pure Unicode character array strings.  Need to
+ *	commit to a consistent memory allocation failure handling policy.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ReplaceObj(
+    Tcl_Interp *interp,		/* Interpreter for error logging, may be NULL */
+    Tcl_Obj *strObj,	    	/* String being modified */
+    int startIndex,		/* Index at which to insert/remove/replace */
+    int removeCount,		/* Number of characters to remove or replace */
+    Tcl_Obj *insObj)	    	/* Substring to insert/replace, may be NULL */
+{
+    int idx;		    	/* Effective start index */
+    int del;		    	/* Effective number of characters to remove */
+    int pureBin;		/* 1 if byte array with no string rep */
+    int pureUni;    	    	/* 1 if Unicode with no string representation */
+    /* Representations of strObj (string being modified) */
+    unsigned char *strBin;	/* String being modified, byte array */
+    Tcl_UniChar   *strUni;	/* String being modified, Unicode char array */
+    int		   strLen;	/* String being modified, byte or char count */
+    /* Representations of insObj (substring to insert or replace) */
+    unsigned char *insBin;	/* String to insert, byte array */
+    Tcl_UniChar   *insUni;	/* String to insert, Unicode character array */
+    int		   insLen;	/* String to insert, byte or character count */
+    /* Representations of output string */
+    unsigned char *outBin;	/* Output string, byte array */
+    Tcl_UniChar   *outUni;	/* Output string, Unicode character array */
+    String	  *outStr;	/* Output string, Tcl string buffer */
+    Tcl_Obj	  *outObj;	/* Output string, Tcl object */
+
+    /*
+     * Check if strObj is a pure byte array or pure Unicode character array.
+     * Get its length and byte array or Unicode character array representation.
+     */
+
+    if ((pureBin = TclIsPureByteArray(strObj))) {
+	strBin = Tcl_GetByteArrayFromObj(strObj, &strLen);
+    } else {
+	pureUni = !strObj->bytes;
+	strUni = Tcl_GetUnicodeFromObj(strObj, &strLen);
+    }
+
+    /*
+     * Do the same for insObj, and update pureBin or pureUni to indicate if both
+     * strObj and insObj are pure byte arrays or pure Unicode character arrays.
+     * If insObj is NULL, treat it as empty string, which is effectively both a
+     * pure byte array and a pure Unicode character array.
+     */
+
+    if (!insObj) {
+	insLen = 0;
+    } else if (pureBin && (pureBin &= TclIsPureByteArray(insObj))) {
+	insBin = Tcl_GetByteArrayFromObj(insObj, &insLen);
+    } else {
+	pureUni = pureUni && !insObj->bytes;
+	insUni = Tcl_GetUnicodeFromObj(insObj, &insLen);
+    }
+
+    /*
+     * Clip start index and removal count to lie within string length limits.
+     */
+
+    if (startIndex <= 0) {
+	idx = 0;
+    } else if (startIndex >= strLen) {
+	idx = strLen;
+    } else {
+	idx = startIndex;
+    }
+    if (removeCount <= 0) {
+	del = 0;
+    } else if (idx + removeCount >= strLen) {
+	del = strLen - idx;
+    } else {
+	del = removeCount;
+    }
+
+    /*
+     * Setup is complete.  Now perform the actual string replacement.
+     */
+
+    if (!insLen && !del) {
+	/*
+	 * If insObj is empty/NULL and no removal is being done, return strObj.
+	 */
+
+	outObj = strObj;
+    } else if (!strLen) {
+	/*
+	 * If strObj is empty, return insObj, which is guaranteed non-NULL.
+	 */
+
+	outObj = insObj;
+    } else if (pureBin) {
+	/*
+	 * Optimize the pure byte array case to avoid shimmering.  If either
+	 * byte array argument is unshared, modify it in place.  If both
+	 * arguments are shared, create a new, unshared byte array result.
+	 * ASCII strings are frequently represented as pure byte arrays.
+	 */
+
+	if (Tcl_IsShared(strObj) && (!insObj || Tcl_IsShared(insObj))) {
+	    /*
+	     * Both arguments are shared, so fill a new byte array with bytes
+	     * from strObj and insObj.
+	     */
+
+	    outObj = Tcl_NewByteArrayObj(NULL, strLen + insLen - del);
+	    outBin = Tcl_GetByteArrayFromObj(outObj, NULL);
+	    if (idx) {
+		memcpy(outBin, strBin, idx);
+	    }
+	    if (insLen) {
+		memcpy(outBin + idx, insBin, insLen);
+	    }
+	    if (strLen != idx + del) {
+		memcpy(outBin + idx + insLen, strBin + idx + del,
+			strLen - idx - del);
+	    }
+	} else {
+	    /*
+	     * An argument is unshared and can be modified in place.  Note: At
+	     * this point, if insObj is NULL, strObj is necessarily unshared.
+	     */
+
+	    if (!Tcl_IsShared(strObj)) {
+		outObj = strObj;
+	    } else {
+		outObj = insObj;
+	    }
+
+	    /*
+	     * If more bytes are about to be inserted than deleted, increase the
+	     * allocation now.  Defer decreasing allocation until later to avoid
+	     * accessing memory after deallocating it.
+	     */
+
+	    if (insLen > del) {
+		outBin = Tcl_SetByteArrayLength(outObj, strLen + insLen - del);
+	    } else {
+		outBin = Tcl_GetByteArrayFromObj(outObj, NULL);
+	    }
+
+	    if (!Tcl_IsShared(strObj)) {
+		/*
+		 * Handle modifying strObj in place.  The bytes before idx are
+		 * already where they need to be.  Adjust the position of the
+		 * bytes after the end of the insert/replace/delete region, then
+		 * insert the substring.
+		 */
+
+		if (insLen != del && strLen != idx + del) {
+		    memmove(outBin + idx + insLen, outBin + idx + del,
+			    strLen - idx - del);
+		}
+		if (insLen) {
+		    memcpy(outBin + idx, insBin, insLen);
+		}
+	    } else {
+		/*
+		 * Handle modifying insObj in place.  Move the insObj bytes to
+		 * idx, then copy strObj in two parts before and after insObj.
+		 */
+
+		if (idx && insLen) {
+		    memmove(outBin + idx, outBin, insLen);
+		}
+		if (idx) {
+		    memcpy(outBin, strBin, idx);
+		}
+		if (insLen != del && strLen != idx + del) {
+		    memcpy(outBin + idx + insLen, strBin + idx + del,
+			    strLen - idx - del);
+		}
+	    }
+
+	    /*
+	     * Now that all bytes are in place, decrease allocation if more
+	     * bytes were deleted than were inserted.
+	     */
+
+	    if (del > insLen) {
+		Tcl_SetByteArrayLength(outObj, strLen + insLen - del);
+	    }
+	}
+    } else if (pureUni || !Tcl_IsShared(strObj)
+	    || (insObj && !Tcl_IsShared(insObj))) {
+	/*
+	 * Same as above, but for pure Unicode character arrays and for unshared
+	 * arguments.  Modify the unshared argument in place, or create a new
+	 * output object if the arguments are shared.
+	 */
+
+	if (!Tcl_IsShared(strObj)) {
+	    outObj = strObj;
+	} else if (insObj && !Tcl_IsShared(insObj)) {
+	    outObj = insObj;
+	} else {
+	    outObj = Tcl_NewUnicodeObj(strUni, idx);
+	}
+
+	/*
+	 * Increase the string allocation as necessary, and get access to the
+	 * Unicode character array internals.
+	 */
+
+	outStr = GET_STRING(outObj);
+	if (strLen + insLen - del > outStr->maxChars) {
+	    GrowUnicodeBuffer(outObj, strLen + insLen - del);
+	    outStr = GET_STRING(outObj);
+	}
+	outUni = outStr->unicode;
+	outStr->numChars = strLen + insLen - del;
+
+	/*
+	 * Convert output to a pure Unicode character array if not already so.
+	 */
+
+	if (!pureUni) {
+	    TclInvalidateStringRep(outObj);
+	    outStr->allocated = 0;
+	}
+
+	/*
+	 * Rearrange the character array to accomplish the replace operation.
+	 */
+
+	if (!Tcl_IsShared(strObj)) {
+	    /*
+	     * Handle modifying strObj in place.  The characters before idx are
+	     * already where they need to be.  Adjust the position of the
+	     * characters after the end of the insert/replace/delete region,
+	     * then insert the substring.
+	     */
+
+	    memmove(outUni + idx + insLen, outUni + idx + del,
+		    (strLen - idx - del) * sizeof(Tcl_UniChar));
+	    memcpy(outUni + idx, insUni, insLen * sizeof(Tcl_UniChar));
+	} else if (insObj && !Tcl_IsShared(insObj)) {
+	    /*
+	     * Handle modifying insObj in place.  Move the insObj characters to
+	     * idx, then copy strObj in two parts before and after insObj.
+	     */
+
+	    memmove(outUni + idx, outUni, insLen * sizeof(Tcl_UniChar));
+	    memcpy(outUni, strUni, idx * sizeof(Tcl_UniChar));
+	    memcpy(outUni + idx + insLen, strUni + idx + del,
+		    (strLen - idx - del) * sizeof(Tcl_UniChar));
+	} else {
+	    /*
+	     * Both arguments are shared, so fill the new Unicode character
+	     * array with characters from strObj and insObj.
+	     */
+
+	    memcpy(outUni + idx, insUni, insLen * sizeof(Tcl_UniChar));
+	    memcpy(outUni + idx + insLen, strUni + idx + del,
+		    (strLen - idx - del) * sizeof(Tcl_UniChar));
+	}
+    } else if ((!idx || idx == strLen) && !del) {
+	/*
+	 * Inserting at the beginning or end of the string is nothing more than
+	 * concatenating the two strings in either order.
+	 */
+
+	Tcl_Obj *parts[2];
+	
+	if (idx) {
+	    parts[0] = strObj;
+	    parts[1] = insObj;
+	} else {
+	    parts[0] = insObj;
+	    parts[1] = strObj;
+	}
+
+	return TclStringCat(interp, 2, parts, TCL_STRING_IN_PLACE);
+    } else {
+	/*
+	 * Non-byte array, non-Unicode, non-prepend, non-append, non-empty,
+	 * non-unshared case.  Build a new string by concatenating the parts.
+	 */
+
+	outObj = Tcl_NewUnicodeObj(strUni, idx);
+	if (insLen) {
+	    Tcl_AppendObjToObj(outObj, insObj);
+	}
+	if (strLen != idx + del) {
+	    Tcl_AppendUnicodeToObj(outObj, strUni + idx + del,
+		    strLen - idx - del);
+	}
+    }
+
+    return outObj;
+}
+
 /*
  *---------------------------------------------------------------------------
  *

generic/tclStubInit.c

@@ -1603,6 +1603,7 @@ const TclStubs tclStubs = {
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
     Tcl_OpenTcpServerEx, /* 631 */
+    Tcl_ReplaceObj, /* 632 */
 };
 
 /* !END!: Do not edit above this line. */

generic/tclTest.c

@@ -5207,7 +5207,7 @@ TestmainthreadCmd(
     const char **argv)		/* Argument strings. */
 {
     if (argc == 1) {
-	Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
+	Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
 
 	Tcl_SetObjResult(interp, idObj);
 	return TCL_OK;
@@ -5604,8 +5604,8 @@ TestChannelCmd(
 	    return TCL_ERROR;
 	}
 
-	TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
-	Tcl_AppendResult(interp, buf, NULL);
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+		(Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
 	return TCL_OK;
     }
 

generic/tclThreadTest.c

@@ -248,7 +248,7 @@ ThreadObjCmd(
 
     switch ((enum options)option) {
     case THREAD_CANCEL: {
-	long id;
+	Tcl_WideInt id;
 	const char *result;
 	int flags, arg;
 
@@ -264,7 +264,7 @@ ThreadObjCmd(
 		arg++;
 	    }
 	}
-	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	arg++;

generic/tclUtil.c

@@ -110,7 +110,6 @@ static void		FreeThreadHash(ClientData clientData);
 static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
 static int		SetEndOffsetFromAny(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
-static void		UpdateStringOfEndOffset(Tcl_Obj *objPtr);
 static int		FindElement(Tcl_Interp *interp, const char *string,
 			    int stringLength, const char *typeStr,
 			    const char *typeCode, const char **elementPtr,
@@ -119,15 +118,18 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
 /*
  * The following is the Tcl object type definition for an object that
  * represents a list index in the form, "end-offset". It is used as a
- * performance optimization in TclGetIntForIndex. The internal rep is an
- * integer, so no memory management is required for it.
+ * performance optimization in TclGetIntForIndex. The internal rep is 
+ * stored directly in the wideValue, so no memory management is required
+ * for it. This is a caching intrep, keeping the result of a parse
+ * around. This type is only created from a pre-existing string, so an
+ * updateStringProc will never be called and need not exist.
  */
 
-const Tcl_ObjType tclEndOffsetType = {
+static const Tcl_ObjType endOffsetType = {
     "end-offset",			/* name */
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
-    UpdateStringOfEndOffset,		/* updateStringProc */
+    NULL,				/* updateStringProc */
     SetEndOffsetFromAny
 };
 
@@ -2530,7 +2532,8 @@ TclStringMatchObj(
 	udata = Tcl_GetUnicodeFromObj(strObj, &length);
 	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
 	match = TclUniCharMatch(udata, length, uptn, plen, flags);
-    } else if (TclIsPureByteArray(strObj) && !flags) {
+    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
+		&& !flags) {
 	unsigned char *data, *ptn;
 
 	data = Tcl_GetByteArrayFromObj(strObj, &length);
@@ -3649,43 +3652,6 @@ TclGetIntForIndex(
     return TCL_ERROR;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfEndOffset --
- *
- *	Update the string rep of a Tcl object holding an "end-offset"
- *	expression.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Stores a valid string in the object's string rep.
- *
- * This function does NOT free any earlier string rep. If it is called on an
- * object that already has a valid string rep, it will leak memory.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfEndOffset(
-    register Tcl_Obj *objPtr)
-{
-    char buffer[TCL_INTEGER_SPACE + 5];
-    register int len = 3;
-
-    memcpy(buffer, "end", 4);
-    if (objPtr->internalRep.wideValue != 0) {
-	buffer[len++] = '-';
-	len += TclFormatInt(buffer+len, -(objPtr->internalRep.wideValue));
-    }
-    objPtr->bytes = ckalloc((unsigned) len+1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
-    objPtr->length = len;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -3717,7 +3683,7 @@ SetEndOffsetFromAny(
      * If it's already the right type, we're fine.
      */
 
-    if (objPtr->typePtr == &tclEndOffsetType) {
+    if (objPtr->typePtr == &endOffsetType) {
 	return TCL_OK;
     }
 
@@ -3783,7 +3749,7 @@ SetEndOffsetFromAny(
 
     TclFreeIntRep(objPtr);
     objPtr->internalRep.wideValue = offset;
-    objPtr->typePtr = &tclEndOffsetType;
+    objPtr->typePtr = &endOffsetType;
 
     return TCL_OK;
 }

tests/basic.test

@@ -670,7 +670,7 @@ proc l3 {} {
 }
 
 # Do all tests once byte compiled and once with direct string evaluation
-for {set noComp 0} {$noComp <= 1} {incr noComp} {
+foreach noComp {0 1} {
 
 if $noComp {
     interp alias {} run {} testevalex

tests/compile.test

@@ -499,7 +499,8 @@ test compile-15.5 {proper TCL_RETURN code from [return]} {
     apply {{} {catch {set a 1}; return}}
 } ""
 
-for {set noComp 0} {$noComp <= 1} {incr noComp} {
+# Do all tests once byte compiled and once with direct string evaluation
+foreach noComp {0 1} {
 
 if $noComp {
     interp alias {} run {} testevalex

tests/obj.test

@@ -30,7 +30,6 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes
 	bytecode
 	cmdName
 	dict
-	end-offset
 	regexp
 	string
     } {
@@ -52,15 +51,6 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
     lappend result [testobj refcount 1]
 } {{} 12 12 bytearray 3}
 
-test obj-3.1 {Tcl_ConvertToType error} testobj {
-    list [testdoubleobj set 1 12.34] \
-	[catch {testobj convert 1 end-offset} msg] \
-	 $msg
-} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
-test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
-    list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
-} {{} 1 {bad index "": must be end?[+-]integer?}}
-
 test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
     set result ""
     lappend result [testobj freeallvars]
@@ -551,43 +541,6 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj {
 } {{} 1024 1024 int 4 4 0 int 3 2}
 
 
-test obj-31.1 {regenerate string rep of "end"} testobj {
-    testobj freeallvars
-    teststringobj set 1 end
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end
-test obj-31.2 {regenerate string rep of "end-1"} testobj {
-    testobj freeallvars
-    teststringobj set 1 end-0x1
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end-1
-test obj-31.3 {regenerate string rep of "end--1"} testobj {
-    testobj freeallvars
-    teststringobj set 1 end--0x1
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end--1
-test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj {
-    testobj freeallvars
-    teststringobj set 1 end-0x7fffffff
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end-2147483647
-test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj {
-    testobj freeallvars
-    teststringobj set 1 end--0x7fffffff
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end--2147483647
-test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} {
-    testobj freeallvars
-    teststringobj set 1 end--0x80000000
-    testobj convert 1 end-offset
-    testobj invalidateStringRep 1
-} end--2147483648
-
 test obj-32.1 {freeing very large object trees} {
     set x {}
     for {set i 0} {$i<100000} {incr i} {

tests/stringComp.test

@@ -1,801 +0,0 @@
-# Commands covered:  string
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
-#
-# This differs from the original string tests in that the tests call
-# things in procs, which uses the compiled string code instead of
-# the runtime parse string code.  The tests of import should match
-# their equivalent number in string.test.
-#
-# Copyright (c) 2001 by ActiveState Corporation.
-# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
-
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-# Some tests require the testobj command
-
-testConstraint testobj [expr {[info commands testobj] != {}}]
-testConstraint memory [llength [info commands memory]]
-if {[testConstraint memory]} {
-    proc getbytes {} {
-	set lines [split [memory info] \n]
-	return [lindex $lines 3 3]
-    }
-    proc leaktest {script {iterations 3}} {
-	set end [getbytes]
-	for {set i 0} {$i < $iterations} {incr i} {
-	    uplevel 1 $script
-	    set tmp $end
-	    set end [getbytes]
-	}
-	return [expr {$end - $tmp}]
-    }
-}
-
-test stringComp-1.1 {error conditions} {
-    proc foo {} {string gorp a b}
-    list [catch {foo} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test stringComp-1.2 {error conditions} {
-    proc foo {} {string}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
-test stringComp-1.3 {error condition - undefined method during compile} {
-    # We don't want this to complain about 'never' because it may never
-    # be called, or string may get redefined.  This must compile OK.
-    proc foo {str i} {
-        if {"yes" == "no"} { string never called but complains here }
-        string index $str $i
-    }
-    foo abc 0
-} a
-
-## Test string compare|equal over equal constraints
-## Use result for string compare, and negate it for string equal
-## The body will be tested both in and outside a proc
-set i 0
-foreach {tname tbody tresult tcode} {
-    {too few args} {
-	string compare a
-    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
-    {bad args} {
-	string compare a b c
-    } {bad option "a": must be -nocase or -length} {error}
-    {bad args} {
-	string compare -length -nocase str1 str2
-    } {expected integer but got "-nocase"} {error}
-    {too many args} {
-	string compare -length 10 -nocase str1 str2 str3
-    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
-    {compare with length unspecified} {
-	string compare -length 10 10
-    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
-    {basic operation fail} {
-	string compare abcde abdef
-    } {-1} {}
-    {basic operation success} {
-	string compare abcde abcde
-    } {0} {}
-    {with length} {
-	string compare -length 2 abcde abxyz
-    } {0} {}
-    {with special index} {
-	string compare -length end-3 abcde abxyz
-    } {expected integer but got "end-3"} {error}
-    {unicode} {
-	string compare ab\u7266 ab\u7267
-    } {-1} {}
-    {unicode} {string compare \334 \u00dc} 0 {}
-    {unicode} {string compare \334 \u00fc} -1 {}
-    {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
-    {high bit} {
-	# This test will fail if the underlying comparaison
-	# is using signed chars instead of unsigned chars.
-	# (like SunOS's default memcmp thus the compat/memcmp.c)
-	string compare "\x80" "@"
-	# Nb this tests works also in utf8 space because \x80 is
-	# translated into a 2 or more bytelength but whose first byte has
-	# the high bit set.
-    } {1} {}
-    {-nocase 1} {string compare -nocase abcde abdef} {-1} {}
-    {-nocase 2} {string compare -nocase abcde Abdef} {-1} {}
-    {-nocase 3} {string compare -nocase abcde ABCDE} {0} {}
-    {-nocase 4} {string compare -nocase abcde abcde} {0} {}
-    {-nocase unicode} {
-	string compare -nocase \334 \u00dc
-    } 0 {}
-    {-nocase unicode} {
-	string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334
-    } 0 {}
-    {-nocase with length} {
-	string compare -length 2 -nocase abcde Abxyz
-    } {0} {}
-    {-nocase with length} {
-	string compare -nocase -length 3 abcde Abxyz
-    } {-1} {}
-    {-nocase with length <= 0} {
-	string compare -nocase -length -1 abcde AbCdEf
-    } {-1} {}
-    {-nocase with excessive length} {
-	string compare -nocase -length 50 AbCdEf abcde
-    } {1} {}
-    {-len unicode} {
-	# These are strings that are 6 BYTELENGTH long, but the length
-	# shouldn't make a different because there are actually 3 CHARS long
-	string compare -len 5 \334\334\334 \334\334\374
-    } -1 {}
-    {-nocase with special index} {
-	string compare -nocase -length end-3 Abcde abxyz
-    } {expected integer but got "end-3"} error
-    {null strings} {
-	string compare "" ""
-    } 0 {}
-    {null strings} {
-	string compare "" foo
-    } -1 {}
-    {null strings} {
-	string compare foo ""
-    } 1 {}
-    {-nocase null strings} {
-	string compare -nocase "" ""
-    } 0 {}
-    {-nocase null strings} {
-	string compare -nocase "" foo
-    } -1 {}
-    {-nocase null strings} {
-	string compare -nocase foo ""
-    } 1 {}
-    {with length, unequal strings} {
-	string compare -length 2 abc abde
-    } 0 {}
-    {with length, unequal strings} {
-	string compare -length 2 ab abde
-    } 0 {}
-    {with NUL character vs. other ASCII} {
-	# Be careful here, since UTF-8 rep comparison with memcmp() of
-	# these puts chars in the wrong order
-	string compare \x00 \x01
-    } -1 {}
-    {high bit} {
-	string compare "a\x80" "a@"
-    } 1 {}
-    {high bit} {
-	string compare "a\x00" "a\x01"
-    } -1 {}
-    {high bit} {
-	string compare "\x00\x00" "\x00\x01"
-    } -1 {}
-    {binary equal} {
-	string compare [binary format a100 0] [binary format a100 0]
-    } 0 {}
-    {binary neq} {
-	string compare [binary format a100a 0 1] [binary format a100a 0 0]
-    } 1 {}
-    {binary neq inequal length} {
-	string compare [binary format a20a 0 1] [binary format a100a 0 0]
-    } 1 {}
-} {
-    if {$tname eq ""} { continue }
-    if {$tcode eq ""} { set tcode ok }
-    test stringComp-2.[incr i] "string compare, $tname" \
-	-body [list eval $tbody] \
-	-returnCodes $tcode -result $tresult
-    test stringComp-2.[incr i] "string compare bc, $tname" \
-	-body "[list proc foo {} $tbody];foo" \
-	-returnCodes $tcode -result $tresult
-    if {"error" ni $tcode} {
-	set tresult [expr {!$tresult}]
-    } else {
-	set tresult [string map {compare equal} $tresult]
-    }
-    set tbody [string map {compare equal} $tbody]
-    test stringComp-2.[incr i] "string equal, $tname" \
-	-body [list eval $tbody] \
-	-returnCodes $tcode -result $tresult
-    test stringComp-2.[incr i] "string equal bc, $tname" \
-	-body "[list proc foo {} $tbody];foo" \
-	-returnCodes $tcode -result $tresult
-}
-
-# need a few extra tests short abbr cmd
-test stringComp-3.1 {string compare, shortest method name} {
-    proc foo {} {string co abcde ABCDE}
-    foo
-} 1
-test stringComp-3.2 {string equal, shortest method name} {
-    proc foo {} {string e abcde ABCDE}
-    foo
-} 0
-test stringComp-3.3 {string equal -nocase} {
-    proc foo {} {string eq -nocase abcde ABCDE}
-    foo
-} 1
-
-test stringComp-4.1 {string first, too few args} {
-    proc foo {} {string first a}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-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?[+-]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
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test stringComp-4.4 {string first} {
-    proc foo {} {string first bq abcdefgbcefgbqrs}
-    foo
-} 12
-test stringComp-4.5 {string first} {
-    proc foo {} {string fir bcd abcdefgbcefgbqrs}
-    foo
-} 1
-test stringComp-4.6 {string first} {
-    proc foo {} {string f b abcdefgbcefgbqrs}
-    foo
-} 1
-test stringComp-4.7 {string first} {
-    proc foo {} {string first xxx x123xx345xxx789xxx012}
-    foo
-} 9
-test stringComp-4.8 {string first} {
-    proc foo {} {string first "" x123xx345xxx789xxx012}
-    foo
-} -1
-test stringComp-4.9 {string first, unicode} {
-    proc foo {} {string first x abc\u7266x}
-    foo
-} 4
-test stringComp-4.10 {string first, unicode} {
-    proc foo {} {string first \u7266 abc\u7266x}
-    foo
-} 3
-test stringComp-4.11 {string first, start index} {
-    proc foo {} {string first \u7266 abc\u7266x 3}
-    foo
-} 3
-test stringComp-4.12 {string first, start index} {
-    proc foo {} {string first \u7266 abc\u7266x 4}
-    foo
-} -1
-test stringComp-4.13 {string first, start index} {
-    proc foo {} {string first \u7266 abc\u7266x end-2}
-    foo
-} 3
-test stringComp-4.14 {string first, negative start index} {
-    proc foo {} {string first b abc -1}
-    foo
-} 1
-
-test stringComp-5.1 {string index} {
-    proc foo {} {string index}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test stringComp-5.2 {string index} {
-    proc foo {} {string index a b c}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test stringComp-5.3 {string index} {
-    proc foo {} {string index abcde 0}
-    foo
-} a
-test stringComp-5.4 {string index} {
-    proc foo {} {string in abcde 4}
-    foo
-} e
-test stringComp-5.5 {string index} {
-    proc foo {} {string index abcde 5}
-    foo
-} {}
-test stringComp-5.6 {string index} {
-    proc foo {} {string index abcde -10}
-    list [catch {foo} msg] $msg
-} {0 {}}
-test stringComp-5.7 {string index} {
-    proc foo {} {string index a xyz}
-    list [catch {foo} msg] $msg
-} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
-test stringComp-5.8 {string index} {
-    proc foo {} {string index abc end}
-    foo
-} c
-test stringComp-5.9 {string index} {
-    proc foo {} {string index abc end-1}
-    foo
-} b
-test stringComp-5.10 {string index, unicode} {
-    proc foo {} {string index abc\u7266d 4}
-    foo
-} d
-test stringComp-5.11 {string index, unicode} {
-    proc foo {} {string index abc\u7266d 3}
-    foo
-} \u7266
-test stringComp-5.12 {string index, unicode over char length, under byte length} {
-    proc foo {} {string index \334\374\334\374 6}
-    foo
-} {}
-test stringComp-5.13 {string index, bytearray object} {
-    proc foo {} {string index [binary format a5 fuz] 0}
-    foo
-} f
-test stringComp-5.14 {string index, bytearray object} {
-    proc foo {} {string index [binary format I* {0x50515253 0x52}] 3}
-    foo
-} S
-test stringComp-5.15 {string index, bytearray object} {
-    proc foo {} {
-	set b [binary format I* {0x50515253 0x52}]
-	set i1 [string index $b end-6]
-	set i2 [string index $b 1]
-	string compare $i1 $i2
-    }
-    foo
-} 0
-test stringComp-5.16 {string index, bytearray object with string obj shimmering} {
-    proc foo {} {
-	set str "0123456789\x00 abcdedfghi"
-	binary scan $str H* dump
-	string compare [string index $str 10] \x00
-    }
-    foo
-} 0
-test stringComp-5.17 {string index, bad integer} -body {
-    proc foo {} {string index "abc" 0o8}
-    list [catch {foo} msg] $msg
-} -match glob -result {1 {*invalid octal number*}}
-test stringComp-5.18 {string index, bad integer} -body {
-    proc foo {} {string index "abc" end-0o0289}
-    list [catch {foo} msg] $msg
-} -match glob -result {1 {*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
-} {}
-test stringComp-5.20 {string index, bytearray object out of bounds} {
-    proc foo {} {string index [binary format I* {0x50515253 0x52}] 20}
-    foo
-} {}
-
-
-proc largest_int {} {
-    # This will give us what the largest valid int on this machine is,
-    # so we can test for overflow properly below on >32 bit systems
-    set int 1
-    set exp 7; # assume we get at least 8 bits
-    while {$int > 0} { set int [expr {1 << [incr exp]}] }
-    return [expr {$int-1}]
-}
-
-## string is
-## not yet bc
-
-catch {rename largest_int {}}
-
-## string last
-## not yet bc
-
-## string length
-## not yet bc
-test stringComp-8.1 {string bytelength} {
-    proc foo {} {string bytelength}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string bytelength string"}}
-test stringComp-8.2 {string bytelength} {
-    proc foo {} {string bytelength a b}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string bytelength string"}}
-test stringComp-8.3 {string bytelength} {
-    proc foo {} {string bytelength "\u00c7"}
-    foo
-} 2
-test stringComp-8.4 {string bytelength} {
-    proc foo {} {string b ""}
-    foo
-} 0
-
-## string length
-##
-test stringComp-9.1 {string length} {
-    proc foo {} {string length}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test stringComp-9.2 {string length} {
-    proc foo {} {string length a b}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test stringComp-9.3 {string length} {
-    proc foo {} {string length "a little string"}
-    foo
-} 15
-test stringComp-9.4 {string length} {
-    proc foo {} {string le ""}
-    foo
-} 0
-test stringComp-9.5 {string length, unicode} {
-    proc foo {} {string le "abcd\u7266"}
-    foo
-} 5
-test stringComp-9.6 {string length, bytearray object} {
-    proc foo {} {string length [binary format a5 foo]}
-    foo
-} 5
-test stringComp-9.7 {string length, bytearray object} {
-    proc foo {} {string length [binary format I* {0x50515253 0x52}]}
-    foo
-} 8
-
-## string map
-## not yet bc
-
-## string match
-##
-test stringComp-11.1 {string match, too few args} {
-    proc foo {} {string match a}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
-test stringComp-11.2 {string match, too many args} {
-    proc foo {} {string match a b c d}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
-test stringComp-11.3 {string match} {
-    proc foo {} {string match abc abc}
-    foo
-} 1
-test stringComp-11.4 {string match} {
-    proc foo {} {string mat abc abd}
-    foo
-} 0
-test stringComp-11.5 {string match} {
-    proc foo {} {string match ab*c abc}
-    foo
-} 1
-test stringComp-11.6 {string match} {
-    proc foo {} {string match ab**c abc}
-    foo
-} 1
-test stringComp-11.7 {string match} {
-    proc foo {} {string match ab* abcdef}
-    foo
-} 1
-test stringComp-11.8 {string match} {
-    proc foo {} {string match *c abc}
-    foo
-} 1
-test stringComp-11.9 {string match} {
-    proc foo {} {string match *3*6*9 0123456789}
-    foo
-} 1
-test stringComp-11.10 {string match} {
-    proc foo {} {string match *3*6*9 01234567890}
-    foo
-} 0
-test stringComp-11.11 {string match} {
-    proc foo {} {string match a?c abc}
-    foo
-} 1
-test stringComp-11.12 {string match} {
-    proc foo {} {string match a??c abc}
-    foo
-} 0
-test stringComp-11.13 {string match} {
-    proc foo {} {string match ?1??4???8? 0123456789}
-    foo
-} 1
-test stringComp-11.14 {string match} {
-    proc foo {} {string match {[abc]bc} abc}
-    foo
-} 1
-test stringComp-11.15 {string match} {
-    proc foo {} {string match {a[abc]c} abc}
-    foo
-} 1
-test stringComp-11.16 {string match} {
-    proc foo {} {string match {a[xyz]c} abc}
-    foo
-} 0
-test stringComp-11.17 {string match} {
-    proc foo {} {string match {12[2-7]45} 12345}
-    foo
-} 1
-test stringComp-11.18 {string match} {
-    proc foo {} {string match {12[ab2-4cd]45} 12345}
-    foo
-} 1
-test stringComp-11.19 {string match} {
-    proc foo {} {string match {12[ab2-4cd]45} 12b45}
-    foo
-} 1
-test stringComp-11.20 {string match} {
-    proc foo {} {string match {12[ab2-4cd]45} 12d45}
-    foo
-} 1
-test stringComp-11.21 {string match} {
-    proc foo {} {string match {12[ab2-4cd]45} 12145}
-    foo
-} 0
-test stringComp-11.22 {string match} {
-    proc foo {} {string match {12[ab2-4cd]45} 12545}
-    foo
-} 0
-test stringComp-11.23 {string match} {
-    proc foo {} {string match {a\*b} a*b}
-    foo
-} 1
-test stringComp-11.24 {string match} {
-    proc foo {} {string match {a\*b} ab}
-    foo
-} 0
-test stringComp-11.25 {string match} {
-    proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
-    foo
-} 1
-test stringComp-11.26 {string match} {
-    proc foo {} {string match ** ""}
-    foo
-} 1
-test stringComp-11.27 {string match} {
-    proc foo {} {string match *. ""}
-    foo
-} 0
-test stringComp-11.28 {string match} {
-    proc foo {} {string match "" ""}
-    foo
-} 1
-test stringComp-11.29 {string match} {
-    proc foo {} {string match \[a a}
-    foo
-} 1
-test stringComp-11.30 {string match, bad args} {
-    proc foo {} {string match - b c}
-    list [catch {foo} msg] $msg
-} {1 {bad option "-": must be -nocase}}
-test stringComp-11.31 {string match case} {
-    proc foo {} {string match a A}
-    foo
-} 0
-test stringComp-11.32 {string match nocase} {
-    proc foo {} {string match -n a A}
-    foo
-} 1
-test stringComp-11.33 {string match nocase} {
-    proc foo {} {string match -nocase a\334 A\374}
-    foo
-} 1
-test stringComp-11.34 {string match nocase} {
-    proc foo {} {string match -nocase a*f ABCDEf}
-    foo
-} 1
-test stringComp-11.35 {string match case, false hope} {
-    # This is true because '_' lies between the A-Z and a-z ranges
-    proc foo {} {string match {[A-z]} _}
-    foo
-} 1
-test stringComp-11.36 {string match nocase range} {
-    # This is false because although '_' lies between the A-Z and a-z ranges,
-    # we lower case the end points before checking the ranges.
-    proc foo {} {string match -nocase {[A-z]} _}
-    foo
-} 0
-test stringComp-11.37 {string match nocase} {
-    proc foo {} {string match -nocase {[A-fh-Z]} g}
-    foo
-} 0
-test stringComp-11.38 {string match case, reverse range} {
-    proc foo {} {string match {[A-fh-Z]} g}
-    foo
-} 1
-test stringComp-11.39 {string match, *\ case} {
-    proc foo {} {string match {*\abc} abc}
-    foo
-} 1
-test stringComp-11.40 {string match, *special case} {
-    proc foo {} {string match {*[ab]} abc}
-    foo
-} 0
-test stringComp-11.41 {string match, *special case} {
-    proc foo {} {string match {*[ab]*} abc}
-    foo
-} 1
-test stringComp-11.42 {string match, *special case} {
-    proc foo {} {string match "*\\" "\\"}
-    foo
-} 0
-test stringComp-11.43 {string match, *special case} {
-    proc foo {} {string match "*\\\\" "\\"}
-    foo
-} 1
-test stringComp-11.44 {string match, *special case} {
-    proc foo {} {string match "*???" "12345"}
-    foo
-} 1
-test stringComp-11.45 {string match, *special case} {
-    proc foo {} {string match "*???" "12"}
-    foo
-} 0
-test stringComp-11.46 {string match, *special case} {
-    proc foo {} {string match "*\\*" "abc*"}
-    foo
-} 1
-test stringComp-11.47 {string match, *special case} {
-    proc foo {} {string match "*\\*" "*"}
-    foo
-} 1
-test stringComp-11.48 {string match, *special case} {
-    proc foo {} {string match "*\\*" "*abc"}
-    foo
-} 0
-test stringComp-11.49 {string match, *special case} {
-    proc foo {} {string match "?\\*" "a*"}
-    foo
-} 1
-test stringComp-11.50 {string match, *special case} {
-    proc foo {} {string match "\\" "\\"}
-    foo
-} 0
-test stringComp-11.51 {string match; *, -nocase and UTF-8} {
-    proc foo {} {string match -nocase [binary format I 717316707] \
-	    [binary format I 2028036707]}
-    foo
-} 1
-test stringComp-11.52 {string match, null char in string} {
-    proc foo {} {
-	set ptn "*abc*"
-	foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
-	    lappend out [string match $ptn $elem]
-	}
-	set out
-    }
-    foo
-} {1 1 1 1}
-test stringComp-11.53 {string match, null char in pattern} {
-    proc foo {} {
-	set out ""
-	foreach {ptn elem} [list \
-		"*\u0000abc\u0000"  "\u0000abc\u0000" \
-		"*\u0000abc\u0000"  "\u0000abc\u0000ef" \
-		"*\u0000abc\u0000*" "\u0000abc\u0000ef" \
-		"*\u0000abc\u0000"  "@\u0000abc\u0000ef" \
-		"*\u0000abc\u0000*"  "@\u0000abc\u0000ef" \
-		] {
-	    lappend out [string match $ptn $elem]
-	}
-	set out
-    }
-    foo
-} {1 0 1 0 1}
-test stringComp-11.54 {string match, failure} {
-    proc foo {} {
-	set longString ""
-	for {set i 0} {$i < 10} {incr i} {
-	    append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
-	}
-	list [string match *cba* $longString] \
-		[string match *a*l*\u0000* $longString] \
-		[string match *a*l*\u0000*123 $longString] \
-		[string match *a*l*\u0000*123* $longString] \
-		[string match *a*l*\u0000*cba* $longString] \
-		[string match *===* $longString]
-    }
-    foo
-} {0 1 1 1 0 0}
-
-## string range
-test stringComp-12.1 {Bug 3588366: end-offsets before start} {
-    apply {s {
-	string range $s 0 end-5
-    }} 12345
-} {}
-
-## string repeat
-## not yet bc
-
-## string replace
-test stringComp-14.1 {Bug 82e7f67325} {
-    apply {x {
-	set a [join $x {}]
-	lappend b [string length [string replace ___! 0 2 $a]]
-	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-    }} {a b}
-} {3 3}
-test stringComp-14.2 {Bug 82e7f67325} memory {
-    # As in stringComp-14.1, but make sure we don't retain too many refs
-    leaktest {
-	apply {x {
-	    set a [join $x {}]
-	    lappend b [string length [string replace ___! 0 2 $a]]
-	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-	}} {a b}
-    }
-} {0}
-test stringComp-14.3 {Bug 0dca3bfa8f} {
-    apply {arg {
-	set argCopy $arg
-	set arg [string replace $arg 1 2 aa]
-	# Crashes in comparison before fix
-	expr {$arg ne $argCopy}
-    }} abcde
-} 1
-test stringComp-14.4 {Bug 1af8de570511} {
-    apply {{x y} {
-	# Generate an unshared string value
-	set val ""
-	for { set i 0 } { $i < $x } { incr i } {
-	    set val [format "0%s" $val]
-	}
-	string replace $val[unset val] 1 1 $y
-    }} 4 x
-} 0x00
-test stringComp-14.5 {} {
-    string length [string replace [string repeat a\u00fe 2] 3 end {}]
-} 3
-
-## string tolower
-## not yet bc
-
-## string toupper
-## not yet bc
-
-## string totitle
-## not yet bc
-
-## string trim*
-## not yet bc
-
-## string word*
-## not yet bc
-
-## string cat
-test stringComp-29.1 {string cat, no arg} {
-    proc foo {} {string cat}
-    foo
-} ""
-test stringComp-29.2 {string cat, single arg} {
-    proc foo {} {
-	set x FOO
-	string compare $x [string cat $x]
-    }
-    foo
-} 0
-test stringComp-29.3 {string cat, two args} {
-    proc foo {} {
-	set x FOO
-	string compare $x$x [string cat $x $x]
-    }
-    foo
-} 0
-test stringComp-29.4 {string cat, many args} {
-    proc foo {} {
-	set x FOO
-	set n 260
-	set xx [string repeat $x $n]
-	set vv [string repeat {$x} $n]
-	set vvs [string repeat {$x } $n]
-	set r1 [string compare $xx [subst $vv]]
-	set r2 [string compare $xx [eval "string cat $vvs"]]
-	list $r1 $r2
-    }
-    foo
-} {0 0}
-
-
-# cleanup
-catch {rename foo {}}
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# End:

unix/configure

@@ -4260,8 +4260,6 @@ $as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h
     #--------------------------------------------------------------------
     # On a few very rare systems, all of the libm.a stuff is
     # already in libc.a.  Set compiler flags accordingly.
-    # Also, Linux requires the "ieee" library for math to work
-    # right (and it must appear before "-lm").
     #--------------------------------------------------------------------
 
     ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin"
@@ -4271,40 +4269,6 @@ else
   MATH_LIBS="-lm"
 fi
 
-    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5
-$as_echo_n "checking for main in -lieee... " >&6; }
-if ${ac_cv_lib_ieee_main+:} false; then :
-  $as_echo_n "(cached) " >&6
-else
-  ac_check_lib_save_LIBS=$LIBS
-LIBS="-lieee  $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-
-
-int
-main ()
-{
-return main ();
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-  ac_cv_lib_ieee_main=yes
-else
-  ac_cv_lib_ieee_main=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
-    conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5
-$as_echo "$ac_cv_lib_ieee_main" >&6; }
-if test "x$ac_cv_lib_ieee_main" = xyes; then :
-  MATH_LIBS="-lieee $MATH_LIBS"
-fi
-
 
     #--------------------------------------------------------------------
     # Interactive UNIX requires -linet instead of -lsocket, plus it

unix/tcl.m4

@@ -2370,12 +2370,9 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [
     #--------------------------------------------------------------------
     # On a few very rare systems, all of the libm.a stuff is
     # already in libc.a.  Set compiler flags accordingly.
-    # Also, Linux requires the "ieee" library for math to work
-    # right (and it must appear before "-lm").
     #--------------------------------------------------------------------
 
     AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
-    AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
 
     #--------------------------------------------------------------------
     # Interactive UNIX requires -linet instead of -lsocket, plus it