diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclStringObj.c | 36 | ||||
-rw-r--r-- | generic/tclTestObj.c | 68 |
2 files changed, 98 insertions, 6 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 1bfe70d..ecea7be 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.108 2009/02/15 23:13:11 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.109 2009/02/16 04:06:07 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -1241,8 +1241,6 @@ Tcl_AppendObjToObj( * appendObjPtr and append it. */ - /* TODO: Check that append to self works */ - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { /* * If appendObjPtr is not of the "String" type, don't convert it. @@ -1266,7 +1264,6 @@ Tcl_AppendObjToObj( * characters in the final (appended-to) object. */ - /* TODO: Check that append to self works */ bytes = TclGetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; @@ -1332,6 +1329,16 @@ AppendUnicodeToUnicodeRep( } if (numChars >= stringPtr->maxChars) { + /* + * 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 + stringPtr->maxChars) { + offset = unicode - stringPtr->unicode; + } /* TODO: overflow check */ stringPtr->maxChars = 2 * numChars; @@ -1344,6 +1351,11 @@ AppendUnicodeToUnicodeRep( } stringPtr = tmpString; SET_STRING(objPtr, stringPtr); + + /* Relocate unicode if needed; see above. */ + if (offset >= 0) { + unicode = stringPtr->unicode + offset; + } } /* @@ -1484,6 +1496,17 @@ AppendUtfToUtfRep( * explanation of this growth algorithm. */ + /* + * 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; + } + if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { /* * Take care computing the amount of modest growth to avoid @@ -1495,6 +1518,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 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; |