diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 34 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 68 | ||||
| -rw-r--r-- | tests/stringObj.test | 35 |
4 files changed, 141 insertions, 4 deletions
@@ -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 } |