summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclStringObj.c34
-rw-r--r--generic/tclTestObj.c68
-rw-r--r--tests/stringObj.test35
4 files changed, 141 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 0b02323..1884852 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>
* generic/tclPathObj.c (TclPathPart): TclPathPart() was computing
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 6775273..45b0a25 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.70.2.7 2009/03/21 02:54:23 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.70.2.8 2009/03/30 17:47:30 dgp Exp $ */
#include "tclInt.h"
#include "tommath.h"
@@ -1317,6 +1317,17 @@ AppendUnicodeToUnicodeRep(
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));
@@ -1329,6 +1340,11 @@ AppendUnicodeToUnicodeRep(
}
stringPtr = tmpString;
SET_STRING(objPtr, stringPtr);
+
+ /* Relocate unicode if needed; see above. */
+ if (offset >= 0) {
+ unicode = stringPtr->unicode + offset;
+ }
}
/*
@@ -1477,6 +1493,17 @@ AppendUtfToUtfRep(
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 so
* allocate additional space. First, try to double the length
* required. If that fails, try a more modest allocation. See the "TCL
@@ -1495,6 +1522,11 @@ AppendUtfToUtfRep(
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 3fb9794..c0a4275 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.21 2007/12/13 15:23:20 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.21.2.1 2009/03/30 17:47:30 dgp Exp $
*/
#include "tclInt.h"
@@ -993,12 +993,14 @@ TeststringobjCmd(
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", NULL
+ "set", "set2", "setlength", "ualloc", "getunicode",
+ "appendself", "appendself2", NULL
};
if (objc < 3) {
@@ -1166,6 +1168,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;
diff --git a/tests/stringObj.test b/tests/stringObj.test
index d497262..5b0349c 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.16.14.1 2009/03/21 02:54:23 dgp Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.16.14.2 2009/03/30 17:47:30 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -434,6 +434,39 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj {
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
+
if {[testConstraint testobj]} {
testobj freeallvars
}