Limits on list length were too strict. Revised panics to errors where possible.

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} {