Fix bug-fa00fbbbab - seq / lindex discrepancies

Replace macros with static inline functions.
Limit ArithSeries list size to LIST_MAX. This way, shimmering less likely to fail if it happens.
Speed up UpdateStringOfArithSeries.
Fixed issues around indexing into vary large lseq lists.

generic/tclArithSeries.c

@@ -13,25 +13,46 @@
 #include "tclInt.h"
 #include "tclArithSeries.h"
 #include <assert.h>
+#include <math.h>
 
 /* -------------------------- ArithSeries object ---------------------------- */
 
 
-#define ArithSeriesRepPtr(arithSeriesObjPtr) \
-    (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)
+static inline ArithSeries* ArithSeriesRepPtr(Tcl_Obj *arithSeriesObjPtr)
+{
+    return (ArithSeries *)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
+}
 
-#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
-    ((arithSeriesRepPtr)->isDouble ?					\
-     (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
-     :									\
-     ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)))
+static inline double ArithSeriesIndexDbl(
+    ArithSeries *arithSeriesRepPtr,
+    Tcl_WideInt index)
+{
+    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
+    if (arithSeriesRepPtr->isDouble) {
+	return (dblRepPtr->start + ((index) * dblRepPtr->step));
+    } else {
+	return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
+    }
+}
 
-#define ArithSeriesGetInternalRep(objPtr, arithRepPtr)		\
-    do {								\
-	const Tcl_ObjInternalRep *irPtr;				\
-	irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);	\
-	(arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;	\
-    } while (0)
+static inline Tcl_WideInt ArithSeriesIndexInt(
+    ArithSeries *arithSeriesRepPtr,
+    Tcl_WideInt index)
+{
+    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
+    if (arithSeriesRepPtr->isDouble) {
+	return (Tcl_WideInt)(dblRepPtr->start + ((index) * dblRepPtr->step));
+    } else {
+	return (arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
+    }
+}
+
+static inline ArithSeries *ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);
+    return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
+}
 
 
 /*
@@ -354,7 +375,7 @@ TclNewArithSeriesObj(
 	}
     }
 
-    if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) {
+    if (TCL_MAJOR_VERSION < 9 && ((len > ListSizeT_MAX) || (len > LIST_MAX))) {
 	Tcl_SetObjResult(
 	    interp,
 	    Tcl_NewStringObj("max length of a Tcl list exceeded", TCL_INDEX_NONE));
@@ -441,19 +462,13 @@ TclArithSeriesObjIndex(
     }
     arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj);
     if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) {
-	if (interp) {
-	    Tcl_SetObjResult(interp,
-		    Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %"
-			    TCL_Z_MODIFIER "d", index, (arithSeriesRepPtr->len-1)));
-	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	}
-	return NULL;
+	return Tcl_NewObj();
     }
     /* List[i] = Start + (Step * index) */
     if (arithSeriesRepPtr->isDouble) {
-	return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+	return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
     } else {
-	return Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+	return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
     }
 }
 
@@ -591,28 +606,46 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj)
     char *elem, *p;
     Tcl_Obj *elemObj;
     Tcl_Size i;
-    Tcl_WideInt length = 0;
+    Tcl_Size length = 0;
     size_t slen;
 
     /*
      * Pass 1: estimate space.
      */
-    for (i = 0; i < arithSeriesRepPtr->len; i++) {
-	elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
-	elem = Tcl_GetStringFromObj(elemObj, &slen);
-	Tcl_DecrRefCount(elemObj);
-	slen += 1; /* + 1 is for the space or the nul-term */
-	length += slen;
+    if (!arithSeriesRepPtr->isDouble) {
+	for (i = 0; i < arithSeriesRepPtr->len; i++) {
+	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
+	    slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
+	    length += slen;
+	}
+    } else {
+	for (i = 0; i < arithSeriesRepPtr->len; i++) {
+	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
+	    char tmp[TCL_DOUBLE_SPACE+2];
+	    tmp[0] = 0;
+	    Tcl_PrintDouble(NULL,d,tmp);
+	    if ((length + strlen(tmp)) >= TCL_SIZE_SMAX) {
+		break; //
+	    }
+	    length += strlen(tmp);
+	}
     }
+    length += arithSeriesRepPtr->len; // Space for each separator
 
     /*
      * Pass 2: generate the string repr.
      */
 
     p = Tcl_InitStringRep(arithSeriesObj, NULL, length);
+    if (p == NULL) {
+	Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
+    }
     for (i = 0; i < arithSeriesRepPtr->len; i++) {
 	elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
 	elem = Tcl_GetStringFromObj(elemObj, &slen);
+	if (((p - arithSeriesObj->bytes)+slen) > length) {
+	    break;
+	}
 	strcpy(p, elem);
 	p[slen] = ' ';
 	p += slen+1;
@@ -685,7 +718,7 @@ TclArithSeriesObjCopy(
     Tcl_Obj *copyPtr;
     ArithSeries *arithSeriesRepPtr;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
     if (NULL == arithSeriesRepPtr) {
 	if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) {
 	    /* We know this is going to panic, but it's the message we want */
@@ -728,16 +761,29 @@ TclArithSeriesObjRange(
     ArithSeries *arithSeriesRepPtr;
     Tcl_Obj *startObj, *endObj, *stepObj;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
 
     if (fromIdx == TCL_INDEX_NONE) {
 	fromIdx = 0;
     }
-    if (fromIdx > toIdx) {
+    
+    if (fromIdx > toIdx ||
+	(toIdx > arithSeriesRepPtr->len-1 &&
+	 fromIdx > arithSeriesRepPtr->len-1)) {
 	Tcl_Obj *obj;
 	TclNewObj(obj);
 	return obj;
     }
+    
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+    if (toIdx < 0) {
+	toIdx = 0;
+    }
+    if (toIdx > arithSeriesRepPtr->len-1) {
+	toIdx = arithSeriesRepPtr->len-1;
+    }
 
     startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx);
     if (startObj == NULL) {
@@ -778,7 +824,7 @@ TclArithSeriesObjRange(
     TclInvalidateStringRep(arithSeriesObj);
 
     if (arithSeriesRepPtr->isDouble) {
-	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesObj;
+	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
 	double start, end, step;
 	Tcl_GetDoubleFromObj(NULL, startObj, &start);
 	Tcl_GetDoubleFromObj(NULL, endObj, &end);
@@ -852,7 +898,7 @@ TclArithSeriesGetElements(
 	Tcl_Obj **objv;
 	int i, objc;
 
-	ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr);
+	arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
 	objc = arithSeriesRepPtr->len;
 	if (objc > 0) {
 	    if (arithSeriesRepPtr->elements) {
@@ -927,7 +973,7 @@ TclArithSeriesObjReverse(
     double dstart, dend, dstep;
     int isDouble;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
 
     isDouble = arithSeriesRepPtr->isDouble;
     len = arithSeriesRepPtr->len;

tests/lseq.test

@@ -538,12 +538,12 @@ test lseq-4.8 {error case lrange} -body {
 } -returnCodes 1 \
     -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}
 
-test lseq-4.9 {error case lrange} -body {
-    set fred 7
-    set ginger 8
-    lrange [lseq 1 5] $fred $ginger
-} -returnCodes 1 \
-    -result {index 7 is out of bounds 0 to 4}
+test lseq-4.9 {lrange empty/partial sets} -body {
+    foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} {
+        lappend res [lrange [lseq 1 5] $fred $ginger]
+    }
+    set res
+} -result {{} 5 {1 2 3 4 5} {} {}}
 
 # Panic when using variable value?
 test lseq-4.10 {panic using variable index} {
@@ -551,6 +551,13 @@ test lseq-4.10 {panic using variable index} {
     lindex [lseq 10] $i
 } {0}
 
+test lseq-4.11 {bug lseq / lindex discrepancies} {
+    lindex [lseq 0x7fffffff] 0x80000000
+} {}
+
+test lseq-4.12 {bug lseq} {
+    llength [lseq 0x100000000]
+} {4294967296}
 
 # cleanup
 ::tcltest::cleanupTests