* generic/tclStringObj.c: Added protections from invalid memory

        * generic/tclTestObj.c:         accesses when we append (some part of)
        * tests/stringObj.test:         a Tcl_Obj to itself.  Added the
        appendself and appendself2 subcommands to the [teststringobj] testing
        command and added tests to the test suite.  [Bug 2603158]

1 files changed, 66 insertions, 2 deletions

diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index cc194b8..55aec66 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.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: tclTestObj.c,v 1.32 2009/02/14 22:54:19 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.33 2009/02/16 04:06:08 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -989,13 +989,15 @@ TeststringobjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    Tcl_UniChar *unicode;
     int varIndex, option, i, length;
 #define MAX_STRINGS 11
     const char *index, *string, *strings[MAX_STRINGS+1];
     TestString *strPtr;
     static const char *const options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "ualloc", "getunicode", NULL
+	"set", "set2", "setlength", "ualloc", "getunicode", 
+	"appendself", "appendself2", NULL
     };
 
     if (objc < 3) {
@@ -1167,6 +1169,68 @@ TeststringobjCmd(
 	    }
 	    Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
 	    break;
+	case 11:			/* appendself */
+	    if (objc != 4) {
+		goto wrongNumArgs;
+	    }
+	    if (varPtr[varIndex] == NULL) {
+		SetVarToObj(varIndex, Tcl_NewObj());
+	    }
+
+	    /*
+	     * If the object bound to variable "varIndex" is shared, we must
+	     * "copy on write" and append to a copy of the object.
+	     */
+
+	    if (Tcl_IsShared(varPtr[varIndex])) {
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	    }
+
+	    string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
+
+	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if ((i < 0) || (i > length)) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"index value out of range", -1));
+		return TCL_ERROR;
+	    }
+
+	    Tcl_AppendToObj(varPtr[varIndex], string + i, length - i);
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
+	case 12:			/* appendself2 */
+	    if (objc != 4) {
+		goto wrongNumArgs;
+	    }
+	    if (varPtr[varIndex] == NULL) {
+		SetVarToObj(varIndex, Tcl_NewObj());
+	    }
+
+	    /*
+	     * If the object bound to variable "varIndex" is shared, we must
+	     * "copy on write" and append to a copy of the object.
+	     */
+
+	    if (Tcl_IsShared(varPtr[varIndex])) {
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	    }
+
+	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
+
+	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if ((i < 0) || (i > length)) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"index value out of range", -1));
+		return TCL_ERROR;
+	    }
+
+	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    break;
     }
 
     return TCL_OK;