summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xgeneric/tclArithSeries.c74
-rw-r--r--generic/tclArithSeries.h13
-rw-r--r--generic/tclCmdIL.c33
-rw-r--r--generic/tclDecls.h6
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclListObj.c3
-rw-r--r--tests/lseq.test19
7 files changed, 108 insertions, 46 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 93177a7..61b4a9b 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -106,8 +106,10 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
Tcl_WideInt len;
- if (step == 0) return 0;
- len = (step ? (1 + (((end-start))/step)) : 0);
+ if (step == 0) {
+ return 0;
+ }
+ len = 1 + ((end-start)/step);
return (len < 0) ? -1 : len;
}
@@ -227,26 +229,24 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
static void
assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj)
{
- union {
- double d;
- Tcl_WideInt i;
- } *number;
+ void *clientData;
int tcl_number_type;
- if (TclGetNumberFromObj(NULL, numberObj, (ClientData*)&number, &tcl_number_type) != TCL_OK) {
+ if (TclGetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
+ || tcl_number_type == TCL_NUMBER_BIG) {
return;
}
if (useDoubles) {
- if (tcl_number_type == TCL_NUMBER_DOUBLE) {
- *dblNumberPtr = number->d;
+ if (tcl_number_type != TCL_NUMBER_INT) {
+ *dblNumberPtr = *(double *)clientData;
} else {
- *dblNumberPtr = (double)number->i;
+ *dblNumberPtr = (double)*(Tcl_WideInt *)clientData;
}
} else {
if (tcl_number_type == TCL_NUMBER_INT) {
- *intNumberPtr = number->i;
+ *intNumberPtr = *(Tcl_WideInt *)clientData;
} else {
- *intNumberPtr = (Tcl_WideInt)number->d;
+ *intNumberPtr = (Tcl_WideInt)*(double *)clientData;
}
}
}
@@ -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);
@@ -795,7 +818,7 @@ TclArithSeriesGetElements(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *objPtr, /* AbstractList object for which an element
* array is to be returned. */
- int *objcPtr, /* Where to store the count of objects
+ ListSizeT *objcPtr, /* Where to store the count of objects
* referenced by objv. */
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
@@ -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 5e13754..62ceeea 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 */
@@ -4067,12 +4077,9 @@ SequenceIdentifyArgument(
int status;
SequenceOperators opmode;
SequenceByMode bymode;
- union {
- Tcl_WideInt i;
- double d;
- } nvalue;
+ void *clientData;
- status = TclGetNumberFromObj(NULL, argPtr, (ClientData*)&nvalue, keywordIndexPtr);
+ status = TclGetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
if (status == TCL_OK) {
if (numValuePtr) {
*numValuePtr = argPtr;
@@ -4422,10 +4429,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/tclDecls.h b/generic/tclDecls.h
index 5d6e184..25adc95 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4231,7 +4231,7 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GlobalEval(interp, objPtr) \
Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
-MODULE_SCOPE TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(void) {}
+static TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(void) {}
#define Tcl_SaveResult(interp, statePtr) \
do { \
Tcl_SaveResult_(); \
@@ -4240,7 +4240,7 @@ MODULE_SCOPE TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(
Tcl_SetObjResult(interp, Tcl_NewObj()); \
} while(0)
#undef Tcl_RestoreResult
-MODULE_SCOPE TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreResult_(void) {}
+static TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreResult_(void) {}
#define Tcl_RestoreResult(interp, statePtr) \
do { \
Tcl_RestoreResult_(); \
@@ -4249,7 +4249,7 @@ MODULE_SCOPE TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreRe
Tcl_DecrRefCount((statePtr)->objResultPtr); \
} while(0)
#undef Tcl_DiscardResult
-MODULE_SCOPE TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_(void) {}
+static TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_(void) {}
#define Tcl_DiscardResult(statePtr) \
do { \
Tcl_DiscardResult_(); \
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..d18ad59 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2632,7 +2632,8 @@ TclLindexFlat(
/* Handle ArithSeries as special case */
if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- ListSizeT index, listLen = TclArithSeriesObjLength(listObj);
+ Tcl_WideInt listLen = TclArithSeriesObjLength(listObj);
+ ListSizeT index;
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
generated by cgit v0.12 at 2024-11-16 10:14:37 (GMT)