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

4 files changed, 139 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 57a09a1..847370a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2009-03-30  Don Porter  <dgp@users.sourceforge.net>
+
+	* 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]
+
 2009-03-27  Don Porter  <dgp@users.sourceforge.net>
 
 	* tests/fileName.test:	Tests for [Bug 2710920] to guard against
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 32197a7..6490bc6 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.32.2.7 2009/03/21 02:53:18 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.32.2.8 2009/03/30 17:47:09 dgp Exp $ */
 
 #include "tclInt.h"
 
@@ -1242,6 +1242,17 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
     numChars = stringPtr->numChars + appendNumChars;
 
     if (STRING_UALLOC(numChars) >= stringPtr->uallocated) {
+	/*
+	 * Protect against case where unicode points into the existing
+	 * stringPtr->unicode array.  Force it to follow any relocations
+	 * due to the reallocs below.
+	 */
+	int offset = -1;
+	if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode
+		+ 1 + stringPtr->uallocated / sizeof(Tcl_UniChar)) {
+	    offset = unicode - stringPtr->unicode;
+	}
+
      	stringPtr->uallocated = STRING_UALLOC(2 * numChars);
 	tmpString = (String *) attemptckrealloc((char *)stringPtr,
 		STRING_SIZE(stringPtr->uallocated));
@@ -1254,6 +1265,11 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
 	}
 	stringPtr = tmpString;
 	SET_STRING(objPtr, stringPtr);
+
+	/* Relocate unicode if needed; see above. */
+	if (offset >= 0) {
+	    unicode = stringPtr->unicode + offset;
+	}
     }
 
     /*
@@ -1399,6 +1415,16 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
 
     stringPtr = GET_STRING(objPtr);
     if (newLength > (int) stringPtr->allocated) {
+        /*
+	 * Protect against case where unicode points into the existing
+	 * stringPtr->unicode array.  Force it to follow any relocations
+	 * due to the reallocs below.
+	 */
+	int offset = -1;
+	if (bytes >= objPtr->bytes
+		&& bytes <= objPtr->bytes + objPtr->length) {
+	    offset = bytes - objPtr->bytes;
+	}
 
 	/*
 	 * There isn't currently enough space in the string representation
@@ -1419,6 +1445,11 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
 
 	    Tcl_SetObjLength(objPtr, newLength + growth);
 	}
+
+	/* Relocate bytes if needed; see above. */
+	if (offset >=0) {
+	    bytes = objPtr->bytes + offset;
+	}
     }
 
     /*
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 5c45d70..f9181a9 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -12,7 +12,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.12 2002/12/04 13:09:24 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.12.2.1 2009/03/30 17:47:09 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -906,13 +906,14 @@ TeststringobjCmd(clientData, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int varIndex, option, i, length;
+    Tcl_UniChar *unicode;
 #define MAX_STRINGS 11
     char *index, *string, *strings[MAX_STRINGS+1];
     TestString *strPtr;
     static CONST char *options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
 	"set", "set2", "setlength", "ualloc", "getunicode", 
-	(char *) NULL
+	"appendself", "appendself2", (char *) NULL
     };
 
     if (objc < 3) {
@@ -1080,6 +1081,68 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    }
 	    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;
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 359e11a..942645e 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stringObj.test,v 1.15.2.1 2009/03/21 02:53:18 dgp Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.15.2.2 2009/03/30 17:47:09 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -439,6 +439,39 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {
     teststringobj get 1
 } {bar}
 
+test stringObj-15.1 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself 1 0
+} foofoo
+test stringObj-15.2 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself 1 1
+} foooo
+test stringObj-15.3 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself 1 2
+} fooo
+test stringObj-15.4 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself 1 3
+} foo
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 0
+} foofoo
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 1
+} foooo
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 2
+} fooo
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 3
+} foo
+
 testobj freeallvars
 
 # cleanup