From eb79479f18ee1e8f09e786ee930ec52c3bab1080 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 12 Jun 2024 19:54:34 +0000 Subject: ultimately closes [f05f5ef759c1f7f9]: since bigints are not supported yet, trying to use them as series parameters would cause "integer value too large to represent" unless implemented. --- generic/tclArithSeries.c | 62 ++++++++++++++++++++++++++---------------------- generic/tclCmdIL.c | 6 +++-- generic/tclInt.h | 5 ++-- tests/lseq.test | 6 ++++- 4 files changed, 45 insertions(+), 34 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 7a41518..cd3b54f 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -421,8 +421,9 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) * None. *---------------------------------------------------------------------- */ -static void +static int assignNumber( + Tcl_Interp *interp, int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, @@ -431,9 +432,15 @@ assignNumber( void *clientData; int tcl_number_type; - if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK - || tcl_number_type == TCL_NUMBER_BIG) { - return; + if (Tcl_GetNumberFromObj(interp, numberObj, &clientData, + &tcl_number_type) != TCL_OK) { + return TCL_ERROR; + } + if (tcl_number_type == TCL_NUMBER_BIG) { + /* bignum is not supported yet. */ + Tcl_WideInt w; + (void)Tcl_GetWideIntFromObj(interp, numberObj, &w); + return TCL_ERROR; } if (useDoubles) { if (tcl_number_type != TCL_NUMBER_INT) { @@ -448,6 +455,7 @@ assignNumber( *intNumberPtr = (Tcl_WideInt)*(double *)clientData; } } + return TCL_OK; } /* @@ -462,7 +470,7 @@ assignNumber( * Results: * * A Tcl_Obj pointer to the created ArithSeries object. - * An empty Tcl_Obj if the range is invalid. + * NULL if the range is invalid. * * Side Effects: * @@ -470,10 +478,9 @@ assignNumber( *---------------------------------------------------------------------- */ -int +Tcl_Obj * 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 */ @@ -484,31 +491,38 @@ TclNewArithSeriesObj( double dstart, dend, dstep; Tcl_WideInt start, end, step; Tcl_WideInt len = -1; + Tcl_Obj *objPtr; if (startObj) { - assignNumber(useDoubles, &start, &dstart, startObj); + if (assignNumber(interp, useDoubles, &start, &dstart, startObj) != TCL_OK) { + return NULL; + } } else { start = 0; dstart = start; } if (stepObj) { - assignNumber(useDoubles, &step, &dstep, stepObj); + if (assignNumber(interp, useDoubles, &step, &dstep, stepObj) != TCL_OK) { + return NULL; + } if (useDoubles) { step = dstep; } else { dstep = step; } if (dstep == 0) { - TclNewObj(*arithSeriesObj); - return TCL_OK; + TclNewObj(objPtr); + return objPtr; } } if (endObj) { - assignNumber(useDoubles, &end, &dend, endObj); + if (assignNumber(interp, useDoubles, &end, &dend, endObj) != TCL_OK) { + return NULL; + } } if (lenObj) { if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) { - return TCL_ERROR; + return NULL; } } @@ -552,15 +566,13 @@ TclNewArithSeriesObj( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); - return TCL_ERROR; + return NULL; } - if (arithSeriesObj) { - *arithSeriesObj = (useDoubles) + objPtr = (useDoubles) ? NewArithSeriesDbl(dstart, dend, dstep, len) : NewArithSeriesInt(start, end, step, len); - } - return TCL_OK; + return objPtr; } /* @@ -769,12 +781,8 @@ TclArithSeriesObjRange( if (Tcl_IsShared(arithSeriesObj) || ((arithSeriesObj->refCount > 1))) { - Tcl_Obj *newSlicePtr; - if (TclNewArithSeriesObj(interp, &newSlicePtr, - arithSeriesRepPtr->isDouble, startObj, endObj, - stepObj, NULL) != TCL_OK) { - newSlicePtr = NULL; - } + Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(interp, + arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL); Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); @@ -974,10 +982,8 @@ TclArithSeriesObjReverse( ((arithSeriesObj->refCount > 1))) { Tcl_Obj *lenObj; TclNewIntObj(lenObj, len); - if (TclNewArithSeriesObj(interp, &resultObj, isDouble, - startObj, endObj, stepObj, lenObj) != TCL_OK) { - resultObj = NULL; - } + resultObj = TclNewArithSeriesObj(interp, isDouble, + startObj, endObj, stepObj, lenObj); Tcl_DecrRefCount(lenObj); } else { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 986bd1e..f01eb2d 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4352,10 +4352,12 @@ Tcl_LseqObjCmd( /* * Success! Now lets create the series object. */ - status = TclNewArithSeriesObj(interp, &arithSeriesPtr, + arithSeriesPtr = TclNewArithSeriesObj(interp, useDoubles, start, end, step, elementCount); - if (status == TCL_OK) { + status = TCL_ERROR; + if (arithSeriesPtr) { + status = TCL_OK; Tcl_SetObjResult(interp, arithSeriesPtr); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 1b88332..5a09f34 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1081,9 +1081,8 @@ MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr); MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, - Tcl_Obj **arithSeriesObj, int useDoubles, - Tcl_Obj *startObj, Tcl_Obj *endObj, +MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(Tcl_Interp *interp, + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj); /* diff --git a/tests/lseq.test b/tests/lseq.test index 09d4885..fa9d0e5 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -108,13 +108,17 @@ test lseq-1.15 {count with decreasing step} { -result {5 3 1 -1 -3} } -test lseq-1.16 {large numbers} { +test lseq-1.16 {large doubles} { -body { lseq [expr {int(1e6)}] [expr {int(2e6)}] [expr {int(1e5)}] } -result {1000000 1100000 1200000 1300000 1400000 1500000 1600000 1700000 1800000 1900000 2000000} } +test lseq-1.16.2 {large numbers (bigints are not supported yet)} -body { + lseq 0xfffffffffffffffe 0xffffffffffffffff +} -returnCodes 1 -result {integer value too large to represent} + test lseq-1.17 {too many arguments} -body { lseq 12 to 24 by 2 with feeling } -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"} -- cgit v0.12