summaryrefslogtreecommitdiffstats
path: root/generic/tclTestObj.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2009-02-16 04:06:07 (GMT)
committerdgp <dgp@users.sourceforge.net>2009-02-16 04:06:07 (GMT)
commit83b89e4cb82d0744ad11a21b568e43fc6398f605 (patch)
treeea2e98682595184a07576b9fa957f3ccb18537ab /generic/tclTestObj.c
parent53a6c6e15b5a20bc8c7bb870aba701855f8da484 (diff)
downloadtcl-83b89e4cb82d0744ad11a21b568e43fc6398f605.zip
tcl-83b89e4cb82d0744ad11a21b568e43fc6398f605.tar.gz
tcl-83b89e4cb82d0744ad11a21b568e43fc6398f605.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]
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r--generic/tclTestObj.c68
1 files changed, 66 insertions, 2 deletions
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;