diff options
-rwxr-xr-x | generic/tclArithSeries.c | 12 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 4 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | tests/lseq.test | 21 |
4 files changed, 24 insertions, 17 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 937e629..1302780 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -282,7 +282,8 @@ TclNewArithSeriesObj( Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; - Tcl_WideInt start, end, step, len; + Tcl_WideInt start, end, step; + Tcl_WideInt len; if (startObj) { assignNumber(useDoubles, &start, &dstart, startObj); @@ -306,7 +307,12 @@ TclNewArithSeriesObj( assignNumber(useDoubles, &end, &dend, endObj); } if (lenObj) { - Tcl_GetWideIntFromObj(NULL, lenObj, &len); + int tcl_number_type; + Tcl_WideInt *valuePtr; + if (TclGetNumberFromObj(interp, lenObj, (ClientData*)&valuePtr, &tcl_number_type) != TCL_OK) { + return TCL_ERROR; + } + len = *valuePtr; } if (startObj && endObj) { @@ -339,7 +345,7 @@ TclNewArithSeriesObj( } } - if (len < 0 || (Tcl_WideUInt)len > ListSizeT_MAX) { + if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c53b971..c140574 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -5000,7 +5000,7 @@ int Tcl_LeditObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ @@ -5012,7 +5012,7 @@ Tcl_LeditObjCmd( size_t listLen; size_t numToDelete; - if (objc < 4) { + if (objc + 1 < 5) { Tcl_WrongNumArgs(interp, 1, objv, "listVar first last ?element ...?"); return TCL_ERROR; diff --git a/generic/tclInt.h b/generic/tclInt.h index a77e6a6..8df3005 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3607,8 +3607,8 @@ MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LeditObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, +MODULE_SCOPE int Tcl_LeditObjCmd(void *clientData, + Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, Tcl_Interp *interp, size_t objc, diff --git a/tests/lseq.test b/tests/lseq.test index 916229d..45e3cd3 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -65,7 +65,7 @@ test lseq-1.10 {integer lseq with step} { lseq 1 to 10 by 2 } {1 3 5 7 9} -test lseq-1.11 {error case: increasing wrong step direction} knownBug { +test lseq-1.11 {error case: increasing wrong step direction} { lseq 1 to 10 by -2 } {} @@ -113,7 +113,7 @@ test lseq-1.19 {too many arguments extra numeric value} -body { lseq 12 to 24 by 2 7 } -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"} -test lseq-1.20 {bug: wrong length computed} knownBug { +test lseq-1.20 {bug: wrong length computed} { lseq 1 to 10 -1 } {} @@ -128,11 +128,11 @@ test lseq-1.22 {n n by -n} { # # Short-hand use cases # -test lseq-2.2 {step magnitude} knownBug { +test lseq-2.2 {step magnitude} { lseq 10 1 2 ;# this is an empty case since step has wrong sign } {} -test lseq-2.3 {step wrong sign} {arithSeriesDouble knownBug} { +test lseq-2.3 {step wrong sign} arithSeriesDouble { lseq 25. 5. 5 ;# ditto - empty list } {} @@ -166,7 +166,7 @@ test lseq-2.10 {integer lseq with step} { lseq 1 10 2 } {1 3 5 7 9} -test lseq-2.11 {error case: increasing wrong step direction} knownBug { +test lseq-2.11 {error case: increasing wrong step direction} { lseq 1 10 -2 } {} @@ -196,7 +196,7 @@ test lseq-2.17 {large numbers} arithSeriesDouble { # Covered: {10 1 2 } {1 10 2} {1 10 -2} {1 1 1} {1 1 1} {-5 17 3} # Missing: {- - +} {- - -} {- + -} {+ - -} {- - +} {+ + -} -test lseq-2.18 {signs} knownBug { +test lseq-2.18 {signs} { list [lseq -10 -1 2] \ [lseq -10 -1 -1] \ [lseq -10 1 -3] \ @@ -390,7 +390,7 @@ test lseq-3.28 {lreverse bug in ArithSeries} {} { list $r $rr [string equal $r [lreverse $rr]] } {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1} -test lseq-3.29 {edge case: negative count} knownBug { +test lseq-3.29 {edge case: negative count} { lseq -15 } {} @@ -425,7 +425,7 @@ test lseq-4.2 {start expressions} { ## lseq 1 to 10 by -2 ## # -> lseq: invalid step = -2 with a = 1 and b = 10 -test lseq-4.3 {TIP examples} knownBug { +test lseq-4.3 {TIP examples} { set examples {# Examples from TIP-629 # --- Begin --- lseq 10 .. 1 @@ -474,7 +474,7 @@ test lseq-4.3 {TIP examples} knownBug { # # Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case -test lseq-4.4 {lseq corner case} -constraints knownBug -body { +test lseq-4.4 {lseq corner case} -body { set tcmd { set res {} set s [catch {lindex [lseq 10 100] 0} e] @@ -489,7 +489,8 @@ test lseq-4.4 {lseq corner case} -constraints knownBug -body { 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} +} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638} +# {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638} # cleanup |