Attachment "2971669.patch" to
ticket [2971669fff]
added by
kennykb
2010-03-18 01:23:00.
Index: generic/tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.59
diff -b -u -r1.59 tclListObj.c
--- generic/tclListObj.c 24 Feb 2010 14:30:34 -0000 1.59
+++ generic/tclListObj.c 17 Mar 2010 18:21:35 -0000
@@ -832,7 +832,11 @@
}
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;
}
Index: generic/tclTestObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTestObj.c,v
retrieving revision 1.37
diff -b -u -r1.37 tclTestObj.c
--- generic/tclTestObj.c 25 Feb 2010 22:20:10 -0000 1.37
+++ generic/tclTestObj.c 17 Mar 2010 18:21:35 -0000
@@ -50,6 +50,8 @@
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,
@@ -100,6 +102,8 @@
NULL, NULL);
Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
NULL, NULL);
@@ -777,6 +781,102 @@
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 --
Index: tests/listObj.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/listObj.test,v
retrieving revision 1.8
diff -b -u -r1.8 listObj.test
--- tests/listObj.test 27 Jul 2005 18:12:43 -0000 1.8
+++ tests/listObj.test 17 Mar 2010 18:21:35 -0000
@@ -18,6 +18,8 @@
namespace import -force ::tcltest::*
}
+testConstraint testobj [llength [info commands testobj]]
+
catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
# Test removed; tested an internal detail
@@ -175,6 +177,28 @@
string length [list foo\x00help]
} 8
+test listobj-10.1 {Bug [2971669]} {*}{
+ -constraints testobj
+ -setup {
+ testobj freeallvars
+ }
+ -body {
+ set result {}
+ lappend result \
+ [testlistobj set 1 a b c d e] \
+ [testlistobj replace 1 0x7fffffff 0x7fffffff f] \
+ [testlistobj get 1]
+ }
+ -cleanup {
+ testobj freeallvars
+ }
+ -result {{a b c d e} {} {a b c d e f}}
+}
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
\ No newline at end of file
