summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2010-03-18 20:38:43 (GMT)
committerdgp <dgp@users.sourceforge.net>2010-03-18 20:38:43 (GMT)
commit5255a10338236dc3adc27e5f3fd811546f4fc09e (patch)
tree891debe41e41785e24733aec27b1ff525c3ae425 /generic
parent82f9f4d9ac6ecb9764104e6e81e9596a0392009f (diff)
downloadtcl-5255a10338236dc3adc27e5f3fd811546f4fc09e.zip
tcl-5255a10338236dc3adc27e5f3fd811546f4fc09e.tar.gz
tcl-5255a10338236dc3adc27e5f3fd811546f4fc09e.tar.bz2
* generic/tclListObj.c: Prevent in overflow trouble in [lreplace]
* generic/tclTestObj.c: operations. Thanks to kbk for fix and test. * tests/listObj.test: [Bug 2971669].
Diffstat (limited to 'generic')
-rw-r--r--generic/tclListObj.c8
-rw-r--r--generic/tclTestObj.c102
2 files changed, 107 insertions, 3 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 95e3f33..82ffa3d 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.49.2.2 2008/09/10 13:18:11 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.49.2.3 2010/03/18 20:38:43 dgp Exp $
*/
#include "tclInt.h"
@@ -832,7 +832,11 @@ Tcl_ListObjReplace(
}
if (count < 0) {
count = 0;
- } else if (numElems < first+count) {
+ } else if (numElems < first+count || first+count < 0) {
+ /*
+ * The 'first+count < 0' condition here guards agains integer
+ * overflow in determining 'first+count'
+ */
count = numElems - first;
}
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index c0a4275..0326208 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.2.1 2009/03/30 17:47:30 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.21.2.2 2010/03/18 20:38:43 dgp Exp $
*/
#include "tclInt.h"
@@ -48,6 +48,8 @@ static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
@@ -98,6 +100,8 @@ TclObjTest_Init(
(ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
(ClientData) 0, NULL);
+ Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
+ (ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
(ClientData) 0, NULL);
@@ -776,6 +780,102 @@ TestintobjCmd(
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * TestlistobjCmd --
+ *
+ * This function implements the 'testlistobj' command. It is used to
+ * test a few possible corner cases in list object manipulation from
+ * C code that cannot occur at the Tcl level.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * Creates, manipulates and frees list objects.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestlistobjCmd(
+ ClientData clientData, /* Not used */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ /* Subcommands supported by this command */
+ const char* subcommands[] = {
+ "set",
+ "get",
+ "replace"
+ };
+ enum listobjCmdIndex {
+ LISTOBJ_SET,
+ LISTOBJ_GET,
+ LISTOBJ_REPLACE
+ };
+
+ const char* index; /* Argument giving the variable number */
+ int varIndex; /* Variable number converted to binary */
+ int cmdIndex; /* Ordinal number of the subcommand */
+ int first; /* First index in the list */
+ int count; /* Count of elements in a list */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
+ return TCL_ERROR;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
+ 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch(cmdIndex) {
+ case LISTOBJ_SET:
+ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+ Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
+ } else {
+ SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_GET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varIndex)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_REPLACE:
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "varIndex start count ?element...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_IsShared(varPtr[varIndex])) {
+ SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ }
+ Tcl_ResetResult(interp);
+ return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
+ objc-5, objv+5);
+ }
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* TestobjCmd --