Fix out-of-bounds length bug.

6 files changed, 89 insertions, 25 deletions

diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 93177a7..3974808 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -270,8 +270,16 @@ assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tc
  * 	None.
  *----------------------------------------------------------------------
  */
-Tcl_Obj *
-TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj)
+int
+TclNewArithSeriesObj(
+    Tcl_Interp *interp,       /* For error reporting */
+    Tcl_Obj **arithSeriesObj, /* return value */
+    int useDoubles,           /* Flag indicates values start,
+			      ** end, step, are treated as doubles */
+    Tcl_Obj *startObj,        /* Starting value */
+    Tcl_Obj *endObj,          /* Ending limit */
+    Tcl_Obj *stepObj,         /* increment value */
+    Tcl_Obj *lenObj)          /* Number of elements */
 {
     double dstart, dend, dstep;
     Tcl_WideInt start, end, step, len;
@@ -290,7 +298,8 @@ TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj
 	    dstep = step;
 	}
 	if (dstep == 0) {
-	    return Tcl_NewObj();
+	    *arithSeriesObj = Tcl_NewObj();
+	    return TCL_OK;
 	}
     }
     if (endObj) {
@@ -330,11 +339,20 @@ TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj
 	}
     }
 
-    if (useDoubles) {
-	return TclNewArithSeriesDbl(dstart, dend, dstep, len);
-    } else {
-	return TclNewArithSeriesInt(start, end, step, len);
+    if (len > ListSizeT_MAX) {
+	Tcl_SetObjResult(
+	    interp,
+	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	return TCL_ERROR;
     }
+
+    if (arithSeriesObj) {
+	*arithSeriesObj = (useDoubles)
+	    ? TclNewArithSeriesDbl(dstart, dend, dstep, len)
+	    : TclNewArithSeriesInt(start, end, step, len);
+    }
+    return TCL_OK;
 }
 
 /*
@@ -684,6 +702,7 @@ TclArithSeriesObjCopy(
 
 Tcl_Obj *
 TclArithSeriesObjRange(
+    Tcl_Interp *interp,         /* For error message(s) */
     Tcl_Obj *arithSeriesPtr,	/* List object to take a range from. */
     int fromIdx,		/* Index of first element to include. */
     int toIdx)			/* Index of last element to include. */
@@ -711,8 +730,12 @@ TclArithSeriesObjRange(
 
     if (Tcl_IsShared(arithSeriesPtr) ||
 	    ((arithSeriesPtr->refCount > 1))) {
-	Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(arithSeriesRepPtr->isDouble,
-	           startObj, endObj, stepObj, NULL);
+	Tcl_Obj *newSlicePtr;
+	if (TclNewArithSeriesObj(interp, &newSlicePtr,
+	        arithSeriesRepPtr->isDouble, startObj, endObj,
+		stepObj, NULL) != TCL_OK) {
+	    newSlicePtr = NULL;
+	}
 	Tcl_DecrRefCount(startObj);
 	Tcl_DecrRefCount(endObj);
 	Tcl_DecrRefCount(stepObj);
@@ -875,6 +898,7 @@ TclArithSeriesGetElements(
 
 Tcl_Obj *
 TclArithSeriesObjReverse(
+    Tcl_Interp *interp,         /* For error message(s) */
     Tcl_Obj *arithSeriesPtr)	/* List object to reverse. */
 {
     ArithSeries *arithSeriesRepPtr;
@@ -910,8 +934,10 @@ TclArithSeriesObjReverse(
     if (Tcl_IsShared(arithSeriesPtr) ||
 	    ((arithSeriesPtr->refCount > 1))) {
 	Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
-	resultObj = TclNewArithSeriesObj(isDouble,
-		        startObj, endObj, stepObj, lenObj);
+	if (TclNewArithSeriesObj(interp, &resultObj,
+		 isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
+	    resultObj = NULL;
+	}
 	Tcl_DecrRefCount(lenObj);
     } else {
 
diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h
index f855c22..3ace052 100644
--- a/generic/tclArithSeries.h
+++ b/generic/tclArithSeries.h
@@ -40,9 +40,10 @@ MODULE_SCOPE int	TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr,
 MODULE_SCOPE int	TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr,
 			    Tcl_WideInt index, Tcl_Obj **elementObj);
 MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjRange(Tcl_Obj *arithSeriesPtr,
-			    int fromIdx, int toIdx);
-MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjReverse(Tcl_Obj *arithSeriesPtr);
+MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjRange(Tcl_Interp *interp,
+			    Tcl_Obj *arithSeriesPtr, int fromIdx, int toIdx);
+MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjReverse(Tcl_Interp *interp,
+			    Tcl_Obj *arithSeriesPtr);
 MODULE_SCOPE int	TclArithSeriesGetElements(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, int *objcPtr, Tcl_Obj ***objvPtr);
 MODULE_SCOPE Tcl_Obj *	TclNewArithSeriesInt(Tcl_WideInt start,
@@ -50,5 +51,7 @@ MODULE_SCOPE Tcl_Obj *	TclNewArithSeriesInt(Tcl_WideInt start,
 			    Tcl_WideInt len);
 MODULE_SCOPE Tcl_Obj *	TclNewArithSeriesDbl(double start, double end,
 			    double step, Tcl_WideInt len);
-MODULE_SCOPE Tcl_Obj *	TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj,
-			    Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj);
+MODULE_SCOPE int 	TclNewArithSeriesObj(Tcl_Interp *interp,
+			    Tcl_Obj **arithSeriesObj, int useDoubles,
+			    Tcl_Obj *startObj, Tcl_Obj *endObj,
+			    Tcl_Obj *stepObj, Tcl_Obj *lenObj);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 9430eb5..f9dcc0f 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2720,7 +2720,6 @@ Tcl_LrangeObjCmd(
 				/* Argument objects. */
 {
     int listLen, first, last, result;
-
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	return TCL_ERROR;
@@ -2744,7 +2743,13 @@ Tcl_LrangeObjCmd(
     }
 
     if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
-	Tcl_SetObjResult(interp, TclArithSeriesObjRange(objv[1], first, last));
+	Tcl_Obj *rangeObj;
+	rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
+	if (rangeObj) {
+	    Tcl_SetObjResult(interp, rangeObj);
+	} else {
+	    return TCL_ERROR;
+	}
     } else {
 	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
     }
@@ -3137,8 +3142,13 @@ Tcl_LreverseObjCmd(
      *  just to reverse it.
      */
     if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
-        Tcl_SetObjResult(interp, TclArithSeriesObjReverse(objv[1]));
-	return TCL_OK;
+	Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
+	if (resObj) {
+	    Tcl_SetObjResult(interp, resObj);
+	    return TCL_OK;
+	} else {
+	    return TCL_ERROR;
+	}
     } /* end ArithSeries */
 
     /* True List */
@@ -4422,10 +4432,12 @@ Tcl_LseqObjCmd(
     /*
      * Success!  Now lets create the series object.
      */
-    arithSeriesPtr = TclNewArithSeriesObj(useDoubles, start, end, step, elementCount);
+    status = TclNewArithSeriesObj(interp, &arithSeriesPtr,
+		  useDoubles, start, end, step, elementCount);
 
-    Tcl_SetObjResult(interp, arithSeriesPtr);
-    status = TCL_OK;
+    if (status == TCL_OK) {
+	Tcl_SetObjResult(interp, arithSeriesPtr);
+    }
 
  done:
     // Free number arguments.
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f8d5493..5f29bfa 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5154,7 +5154,11 @@ TEBCresume(
 	fromIdx = TclIndexDecode(fromIdx, objc - 1);
 
 	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
-	    objResultPtr = TclArithSeriesObjRange(valuePtr, fromIdx, toIdx);
+	    objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
+	    if (objResultPtr == NULL) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
 	} else {
 	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
 	}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 5034174..12b8386 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2632,7 +2632,7 @@ TclLindexFlat(
 
     /* Handle ArithSeries as special case */
     if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
-	ListSizeT index, listLen = TclArithSeriesObjLength(listObj);
+	Tcl_WideInt index, listLen = TclArithSeriesObjLength(listObj);
 	Tcl_Obj *elemObj = NULL;
 	for (i=0 ; i<indexCount && listObj ; i++) {
 	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
diff --git a/tests/lseq.test b/tests/lseq.test
index ffb8a94..e05b32d 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -472,6 +472,25 @@ test lseq-4.3 {TIP examples} {
     set res
 } {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}
 
+#
+# Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case
+test lseq-4.4 {lseq corner case} -body {
+    set tcmd {
+	set res {}
+	set s [catch {lindex [lseq 10 100] 0} e]
+	lappend res $s $e
+	set s [catch {lindex [lseq 10 9223372036854775000] 0} e]
+	lappend res $s $e
+	set s [catch {llength [lseq 10 9223372036854775000]} e]
+	lappend res $s $e
+	set s [catch {lindex [lseq 10 2147483647] 0} e]
+	lappend res $s $e
+	set s [catch {llength [lseq 10 2147483647]} e]
+	lappend res $s $e
+    }
+    eval $tcmd
+} -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638}
+
 
 # cleanup
 ::tcltest::cleanupTests