1 files changed, 202 insertions, 64 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ba1fc41..3f79ca4 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -323,7 +323,7 @@ Tcl_RegexpObjCmd(
 
 	if (match == 0) {
 	    /*
-	     * We want to set the value of the interpreter result only when
+	     * We want to set the value of the intepreter result only when
 	     * this is the first time through the loop.
 	     */
 
@@ -989,11 +989,8 @@ TclNRSourceObjCmd(
 {
     const char *encodingName = NULL;
     Tcl_Obj *fileName;
-    int result;
-    void **pkgFiles = NULL;
-    void *names = NULL;
 
-    if (objc < 2 || objc > 4) {
+    if (objc != 2 && objc !=4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
 	return TCL_ERROR;
     }
@@ -1011,30 +1008,9 @@ TclNRSourceObjCmd(
 	    return TCL_ERROR;
 	}
 	encodingName = TclGetString(objv[2]);
-    } else if (objc == 3) {
-	/* Handle undocumented -nopkg option. This should only be
-	 * used by the internal ::tcl::Pkg::source utility function. */
-	static const char *const nopkgoptions[] = {
-	    "-nopkg", NULL
-	};
-	int index;
-
-	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
-		"option", TCL_EXACT, &index)) {
-	    return TCL_ERROR;
-	}
-	pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
-	/* Make sure that during the following TclNREvalFile no filenames
-	 * are recorded for inclusion in the "package files" command */
-	names = *pkgFiles;
-	*pkgFiles = NULL;
-    }
-    result = TclNREvalFile(interp, fileName, encodingName);
-    if (pkgFiles) {
-	/* restore "tclPkgFiles" assocdata to how it was. */
-	*pkgFiles = names;
     }
-    return result;
+
+    return TclNREvalFile(interp, fileName, encodingName);
 }
 
 /*
@@ -1200,7 +1176,8 @@ StringFirstCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int start = 0;
+    Tcl_UniChar *needleStr, *haystackStr;
+    int match, start, needleLen, haystackLen;
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1208,23 +1185,82 @@ StringFirstCmd(
 	return TCL_ERROR;
     }
 
+    /*
+     * We are searching haystackStr for the sequence needleStr.
+     */
+
+    match = -1;
+    start = 0;
+    haystackLen = -1;
+
+    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+
     if (objc == 4) {
-	int size = Tcl_GetCharLength(objv[2]);
+	/*
+	 * If a startIndex is specified, we will need to fast forward to that
+	 * point in the string before we think about a match.
+	 */
 
-	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
+	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+		&start) != TCL_OK){
 	    return TCL_ERROR;
 	}
 
-	if (start < 0) {
+	/*
+	 * Reread to prevent shimmering problems.
+	 */
+
+	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+
+	if (start >= haystackLen) {
+	    goto str_first_done;
+	} else if (start > 0) {
+	    haystackStr += start;
+	    haystackLen -= start;
+	} else if (start < 0) {
+	    /*
+	     * Invalid start index mapped to string start; Bug #423581
+	     */
+
 	    start = 0;
 	}
-	if (start >= size) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
-	    return TCL_OK;
+    }
+
+    /*
+     * If the length of the needle is more than the length of the haystack, it
+     * cannot be contained in there so we can avoid searching. [Bug 2960021]
+     */
+
+    if (needleLen > 0 && needleLen <= haystackLen) {
+	register Tcl_UniChar *p, *end;
+
+	end = haystackStr + haystackLen - needleLen + 1;
+	for (p = haystackStr;  p < end;  p++) {
+	    /*
+	     * Scan forward to find the first character.
+	     */
+
+	    if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
+		    (unsigned long) needleLen) == 0)) {
+		match = p - haystackStr;
+		break;
+	    }
 	}
     }
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
-	    objv[2], start)));
+
+    /*
+     * Compute the character index of the matching string by counting the
+     * number of characters before the match.
+     */
+
+    if ((match != -1) && (objc == 4)) {
+	match += start;
+    }
+
+  str_first_done:
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
     return TCL_OK;
 }
 
@@ -1253,31 +1289,76 @@ StringLastCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int last = INT_MAX - 1;
+    Tcl_UniChar *needleStr, *haystackStr, *p;
+    int match, start, needleLen, haystackLen;
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"needleString haystackString ?lastIndex?");
+		"needleString haystackString ?startIndex?");
 	return TCL_ERROR;
     }
 
+    /*
+     * We are searching haystackString for the sequence needleString.
+     */
+
+    match = -1;
+    start = 0;
+    haystackLen = -1;
+
+    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+
     if (objc == 4) {
-	int size = Tcl_GetCharLength(objv[2]);
+	/*
+	 * If a startIndex is specified, we will need to restrict the string
+	 * range to that char index in the string
+	 */
 
-	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
+	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+		&start) != TCL_OK){
 	    return TCL_ERROR;
 	}
 
-	if (last < 0) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
-	    return TCL_OK;
+	/*
+	 * Reread to prevent shimmering problems.
+	 */
+
+	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+
+	if (start < 0) {
+	    goto str_last_done;
+	} else if (start < haystackLen) {
+	    p = haystackStr + start + 1 - needleLen;
+	} else {
+	    p = haystackStr + haystackLen - needleLen;
 	}
-	if (last >= size) {
-	    last = size - 1;
+    } else {
+	p = haystackStr + haystackLen - needleLen;
+    }
+
+    /*
+     * If the length of the needle is more than the length of the haystack, it
+     * cannot be contained in there so we can avoid searching. [Bug 2960021]
+     */
+
+    if (needleLen > 0 && needleLen <= haystackLen) {
+	for (; p >= haystackStr; p--) {
+	    /*
+	     * Scan backwards to find the first character.
+	     */
+
+	    if ((*p == *needleStr) && !memcmp(needleStr, p,
+		    sizeof(Tcl_UniChar) * (size_t)needleLen)) {
+		match = p - haystackStr;
+		break;
+	    }
 	}
     }
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
-	    objv[2], last)));
+
+  str_last_done:
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
     return TCL_OK;
 }
 
@@ -1565,7 +1646,7 @@ StringIsCmd(
 	}
 	break;
     case STR_IS_WIDE:
-	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
+	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
 	    break;
 	}
 
@@ -1792,7 +1873,7 @@ StringMapCmd(
 
     /*
      * This test is tricky, but has to be that way or you get other strange
-     * inconsistencies (see test string-10.20.1 for illustration why!)
+     * inconsistencies (see test string-10.20 for illustration why!)
      */
 
     if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
@@ -2142,7 +2223,9 @@ StringReptCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int count;
+    const char *string1;
+    char *string2;
+    int count, index, length1, length2;
     Tcl_Obj *resultPtr;
 
     if (objc != 3) {
@@ -2160,15 +2243,70 @@ StringReptCmd(
 
     if (count == 1) {
 	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
+	goto done;
     } else if (count < 1) {
-	return TCL_OK;
+	goto done;
+    }
+    string1 = TclGetStringFromObj(objv[1], &length1);
+    if (length1 <= 0) {
+	goto done;
+    }
+
+    /*
+     * Only build up a string that has data. Instead of building it up with
+     * repeated appends, we just allocate the necessary space once and copy
+     * the string value in.
+     *
+     * We have to worry about overflow [Bugs 714106, 2561746].
+     * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
+     * We need to keep 2 <= length2 <= INT_MAX.
+     */
+
+    if (count > INT_MAX/length1) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"result exceeds max size for a Tcl value (%d bytes)",
+		INT_MAX));
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	return TCL_ERROR;
     }
+    length2 = length1 * count;
 
-    if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {
+    /*
+     * Include space for the NUL.
+     */
+
+    string2 = attemptckalloc((unsigned) length2 + 1);
+    if (string2 == NULL) {
+	/*
+	 * Alloc failed. Note that in this case we try to do an error message
+	 * since this is a case that's most likely when the alloc is large and
+	 * that's easy to do with this API. Note that if we fail allocating a
+	 * short string, this will likely keel over too (and fatally).
+	 */
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"string size overflow, out of memory allocating %u bytes",
+		length2 + 1));
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	return TCL_ERROR;
     }
+    for (index = 0; index < count; index++) {
+	memcpy(string2 + (length1 * index), string1, (size_t) length1);
+    }
+    string2[length2] = '\0';
+
+    /*
+     * We have to directly assign this instead of using Tcl_SetStringObj (and
+     * indirectly TclInitStringRep) because that makes another copy of the
+     * data.
+     */
+
+    TclNewObj(resultPtr);
+    resultPtr->bytes = string2;
+    resultPtr->length = length2;
     Tcl_SetObjResult(interp, resultPtr);
+
+  done:
     return TCL_OK;
 }
 
@@ -2717,7 +2855,7 @@ StringCatCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int code;
+    int i;
     Tcl_Obj *objResultPtr;
 
     if (objc < 2) {
@@ -2734,16 +2872,16 @@ StringCatCmd(
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     }
-
-    code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
-	    &objResultPtr);
-
-    if (code == TCL_OK) {
-	Tcl_SetObjResult(interp, objResultPtr);
-	return TCL_OK;
+    objResultPtr = objv[1];
+    if (Tcl_IsShared(objResultPtr)) {
+	objResultPtr = Tcl_DuplicateObj(objResultPtr);
     }
+    for(i = 2;i < objc;i++) {
+	Tcl_AppendObjToObj(objResultPtr, objv[i]);
+    }
+    Tcl_SetObjResult(interp, objResultPtr);
 
-    return code;
+    return TCL_OK;
 }
 
 /*
@@ -4181,7 +4319,7 @@ TclNRTryObjCmd(
 	    }
 
 	    info[0] = objv[i];			/* type */
-	    TclNewLongObj(info[1], code);	/* returnCode */
+	    TclNewIntObj(info[1], code);	/* returnCode */
 	    if (info[2] == NULL) {		/* errorCodePrefix */
 		TclNewObj(info[2]);
 	    }