summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-04-21 17:32:20 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-04-21 17:32:20 (GMT)
commitd3a0ad0b83779f8b3ad8b665c8a64461dfc56b33 (patch)
treeff599a870d9438f3b28c983d0ac8121bea25f65b
parent7522eeff966d066c292c39a89986a78922d65f73 (diff)
parentfb1e4a18589dcd6dcf8bab488503e3ce89873098 (diff)
downloadtcl-d3a0ad0b83779f8b3ad8b665c8a64461dfc56b33.zip
tcl-d3a0ad0b83779f8b3ad8b665c8a64461dfc56b33.tar.gz
tcl-d3a0ad0b83779f8b3ad8b665c8a64461dfc56b33.tar.bz2
Limits on list length were too strict. Revised panics to errors where possible.
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCmdIL.c19
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclListObj.c128
-rw-r--r--tests/lrepeat.test2
5 files changed, 96 insertions, 61 deletions
diff --git a/ChangeLog b/ChangeLog
index 046b900..19d7e47 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
2011-04-21 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclCmdIL.c: Limits on list length were too strict.
+ * generic/tclInt.h: Revised panics to errors where possible.
+ * generic/tclListObj.c:
+ * tests/lrepeat.test:
+
* generic/tclCompile.c: Make sure SetFooFromAny routines react
* generic/tclIO.c: reasonably when passed a NULL interp.
* generic/tclIndexObj.c:
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b6e9f21..64348ad 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2579,24 +2579,15 @@ Tcl_LrepeatObjCmd(
objc -= 2;
objv += 2;
- /*
- * Final sanity check. Total number of elements must fit in a signed
- * integer. We also limit the number of elements to 512M-1 so allocations
- * on 32-bit machines are guaranteed to be less than 2GB! [Bug 2130992]
- */
+ /* Final sanity check. Do not exceed limits on max list length. */
- totalElems = objc * elementCount;
- if (totalElems != 0 && (totalElems/objc != elementCount
- || totalElems/elementCount != objc)) {
- Tcl_AppendResult(interp, "too many elements in result list", NULL);
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- return TCL_ERROR;
- }
- if (totalElems >= 0x20000000) {
- Tcl_AppendResult(interp, "too many elements in result list", NULL);
+ if (elementCount && objc > LIST_MAX/elementCount) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
+ totalElems = objc * elementCount;
/*
* Get an empty list object that is allocated large enough to hold each
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cf32e0d..67aee93 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2441,6 +2441,9 @@ typedef struct List {
* accomodate all elements. */
} List;
+#define LIST_MAX \
+ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
+
/*
* Macro used to get the elements of a list object.
*/
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index d4f7da9..4c40a8b 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -17,7 +17,9 @@
* Prototypes for functions defined later in this file:
*/
-static List * NewListIntRep(int objc, Tcl_Obj *const objv[]);
+static List * AttemptNewList(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static List * NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeListInternalRep(Tcl_Obj *listPtr);
static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -49,16 +51,16 @@ const Tcl_ObjType tclListType = {
*
* NewListIntRep --
*
- * If objc>0 and objv!=NULL, this function creates a list internal rep
- * with objc elements given in the array objv. If objc>0 and objv==NULL
- * it creates the list internal rep of a list with 0 elements, where
- * enough space has been preallocated to store objc elements. If objc<=0,
- * it returns NULL.
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more. Flag value "p" indicates
+ * how to behave on failure.
*
* Results:
- * A new List struct is returned. If objc<=0 or if the allocation fails
- * for lack of memory, NULL is returned. The list returned has refCount
- * 0.
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then if p=0, NULL is returned and otherwise the
+ * routine panics.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
@@ -70,12 +72,13 @@ const Tcl_ObjType tclListType = {
static List *
NewListIntRep(
int objc,
- Tcl_Obj *const objv[])
+ Tcl_Obj *const objv[],
+ int p)
{
List *listRepPtr;
if (objc <= 0) {
- return NULL;
+ Tcl_Panic("NewListIntRep: expects postive element count");
}
/*
@@ -85,12 +88,20 @@ NewListIntRep(
* requires API changes to fix. See [Bug 219196] for a discussion.
*/
- if ((size_t)objc > INT_MAX/sizeof(Tcl_Obj *)) {
+ if ((size_t)objc > LIST_MAX) {
+ if (p) {
+ Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX);
+ }
return NULL;
}
listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*)));
if (listRepPtr == NULL) {
+ if (p) {
+ Tcl_Panic("list creation failed: unable to alloc %u bytes",
+ sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
+ }
return NULL;
}
@@ -117,6 +128,51 @@ NewListIntRep(
/*
*----------------------------------------------------------------------
*
+ * AttemptNewList --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then NULL is returned, and an error message is left
+ * in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+AttemptNewList(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ List *listRepPtr = NewListIntRep(objc, objv, 0);
+
+ if (interp != NULL && listRepPtr == NULL) {
+ if (objc > LIST_MAX) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "list creation failed: unable to alloc %u bytes",
+ sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
+ }
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return listRepPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_NewListObj --
*
* This function is normally called when not debugging: i.e., when
@@ -171,10 +227,7 @@ Tcl_NewListObj(
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
- }
+ listRepPtr = NewListIntRep(objc, objv, 1);
/*
* Now create the object.
@@ -243,10 +296,7 @@ Tcl_DbNewListObj(
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
- }
+ listRepPtr = NewListIntRep(objc, objv, 1);
/*
* Now create the object.
@@ -325,10 +375,7 @@ Tcl_SetListObj(
*/
if (objc > 0) {
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
- }
+ listRepPtr = NewListIntRep(objc, objv, 1);
objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
@@ -586,9 +633,9 @@ Tcl_ListObjAppendElement(
List *oldListRepPtr = listRepPtr;
Tcl_Obj **oldElems;
- listRepPtr = NewListIntRep(newMax, NULL);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
+ listRepPtr = AttemptNewList(interp, newMax, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
}
oldElems = &oldListRepPtr->elements;
elemPtrs = &listRepPtr->elements;
@@ -882,9 +929,9 @@ Tcl_ListObjReplace(
newMax = listRepPtr->maxElemCount;
}
- listRepPtr = NewListIntRep(newMax, NULL);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
+ listRepPtr = AttemptNewList(interp, newMax, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
}
listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
@@ -1550,9 +1597,9 @@ TclListObjSetElement(
Tcl_Obj **oldElemPtrs = elemPtrs;
int i;
- listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
+ listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
if (listRepPtr == NULL) {
- Tcl_Panic("Not enough memory to allocate list");
+ return TCL_ERROR;
}
listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
elemPtrs = &listRepPtr->elements;
@@ -1716,14 +1763,8 @@ SetListFromAny(
*/
Tcl_DictObjSize(NULL, objPtr, &size);
- listRepPtr = NewListIntRep(size > 0 ? 2*size : 1, NULL);
+ listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
if (!listRepPtr) {
- if (interp) {
- Tcl_SetResult(interp,
- "insufficient memory to allocate list working space",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- }
return TCL_ERROR;
}
listRepPtr->elemCount = 2 * size;
@@ -1779,13 +1820,8 @@ SetListFromAny(
* strings.
*/
- listRepPtr = NewListIntRep(estCount, NULL);
- if (!listRepPtr) {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "Not enough memory to allocate the list internal rep", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- }
+ listRepPtr = AttemptNewList(interp, estCount, NULL);
+ if (listRepPtr == NULL) {
return TCL_ERROR;
}
elemPtrs = &listRepPtr->elements;
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
index 6068dea..788bb9b 100644
--- a/tests/lrepeat.test
+++ b/tests/lrepeat.test
@@ -63,7 +63,7 @@ test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
lrepeat 0x10000000 a b c d e f g h
-} -returnCodes error -result {too many elements in result list}
+} -returnCodes error -match glob -result *
## Okay
test lrepeat-2.1 {normal cases} {