diff options
-rwxr-xr-x | generic/tclArithSeries.c | 66 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 6 | ||||
-rw-r--r-- | generic/tclInt.h | 3 | ||||
-rw-r--r-- | tests/lseq.test | 6 |
4 files changed, 48 insertions, 33 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 4b4b892..7618415 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -501,8 +501,9 @@ NewArithSeriesDbl( * None. *---------------------------------------------------------------------- */ -static void +static int assignNumber( + Tcl_Interp *interp, int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, @@ -511,9 +512,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) { @@ -528,6 +535,7 @@ assignNumber( *intNumberPtr = (Tcl_WideInt)*(double *)clientData; } } + return TCL_OK; } /* @@ -541,16 +549,15 @@ 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: * None. *---------------------------------------------------------------------- */ -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 */ @@ -561,31 +568,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; } } @@ -629,15 +643,13 @@ TclNewArithSeriesObj( Tcl_SetObjResult(interp, Tcl_NewStringObj( "max length of a Tcl list exceeded", TCL_AUTO_LENGTH)); 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; } /* @@ -832,14 +844,14 @@ TclArithSeriesObjRange( TclArithSeriesObjStep(arithSeriesObj, &stepObj); Tcl_IncrRefCount(stepObj); - if (Tcl_IsShared(arithSeriesObj) || (arithSeriesObj->refCount > 1)) { - int status = TclNewArithSeriesObj(NULL, newObjPtr, - arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL); - + if (Tcl_IsShared(arithSeriesObj) || ((arithSeriesObj->refCount > 1))) { + Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(interp, + arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL); + *newObjPtr = newSlicePtr; Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); - return status; + return newSlicePtr ? TCL_OK : TCL_ERROR; } /* @@ -1043,10 +1055,8 @@ TclArithSeriesObjReverse( Tcl_Obj *lenObj; TclNewIntObj(lenObj, len); - if (TclNewArithSeriesObj(NULL, &resultObj, isDouble, - startObj, endObj, stepObj, lenObj) != TCL_OK) { - resultObj = NULL; - } + resultObj = TclNewArithSeriesObj(interp, isDouble, + startObj, endObj, stepObj, lenObj); Tcl_DecrRefCount(lenObj); } else { /* @@ -1077,7 +1087,7 @@ TclArithSeriesObjReverse( *newObjPtr = resultObj; - return TCL_OK; + return resultObj ? TCL_OK : TCL_ERROR; } /* diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 836b859..5c20317 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4355,10 +4355,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 ae91625..7a10bda 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3494,8 +3494,7 @@ MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, - Tcl_Obj **arithSeriesPtr, +MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(Tcl_Interp *interp, int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, diff --git a/tests/lseq.test b/tests/lseq.test index b617d7a..74fbdfa 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -109,13 +109,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??"} |