diff options
author | dgp <dgp@noemail.net> | 2009-03-30 17:47:30 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2009-03-30 17:47:30 (GMT) |
commit | 5dfc5a90a6a6b6ecdf14d7afe8df43e9f2ec90e9 (patch) | |
tree | de2005ae858faa3138a29ad678f6e078f6610ade /generic/tclTestObj.c | |
parent | ed6231546114a03bf8179b535ad77413eef8df0b (diff) | |
download | tcl-5dfc5a90a6a6b6ecdf14d7afe8df43e9f2ec90e9.zip tcl-5dfc5a90a6a6b6ecdf14d7afe8df43e9f2ec90e9.tar.gz tcl-5dfc5a90a6a6b6ecdf14d7afe8df43e9f2ec90e9.tar.bz2 |
* 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]
FossilOrigin-Name: f0785bb73d1ccd8a524b32c53d457c63b6bb912f
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r-- | generic/tclTestObj.c | 68 |
1 files changed, 66 insertions, 2 deletions
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; |