From 69ac37dbaeab806d67efd79d047215bcbfe1654c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 28 Sep 2022 11:55:26 +0000 Subject: Don't worry deprecation warnings for Tcl_SaveResult: If TIP #640 is accepted it won't matter any more. Eliminate some compiler warnings Mark some lseq testcases as "knownBug", they still need to be fixed --- generic/tclArithSeries.c | 2 +- generic/tclDecls.h | 10 +--------- generic/tclListObj.c | 2 +- tests/lseq.test | 18 +++++++++--------- 4 files changed, 12 insertions(+), 20 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 023ba4a..d104995 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -339,7 +339,7 @@ TclNewArithSeriesObj( } } - if (len > ListSizeT_MAX) { + if (len < 0 || (Tcl_WideUInt)len > ListSizeT_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 910e67e..7ae6fc3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3892,28 +3892,20 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL) #define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) -static TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(void) {} #define Tcl_SaveResult(interp, statePtr) \ do { \ - Tcl_SaveResult_(); \ *(statePtr) = Tcl_GetObjResult(interp); \ Tcl_IncrRefCount(*(statePtr)); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) -static TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreResult_(void) {} #define Tcl_RestoreResult(interp, statePtr) \ do { \ - Tcl_RestoreResult_(); \ Tcl_ResetResult(interp); \ Tcl_SetObjResult(interp, *(statePtr)); \ Tcl_DecrRefCount(*(statePtr)); \ } while(0) -static TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_(void) {} #define Tcl_DiscardResult(statePtr) \ - do { \ - Tcl_DiscardResult_(); \ - Tcl_DecrRefCount(*(statePtr)); \ - } while(0) + Tcl_DecrRefCount(*(statePtr)) #define Tcl_SetResult(interp, result, freeProc) \ do { \ const char *__result = result; \ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 8349408..b870bca 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2628,7 +2628,7 @@ TclLindexFlat( /* Handle ArithSeries as special case */ if (TclHasInternalRep(listObj,&tclArithSeriesType)) { Tcl_WideInt listLen = TclArithSeriesObjLength(listObj); - int index; + ListSizeT index; Tcl_Obj *elemObj = NULL; for (i=0 ; i lseq: invalid step = -2 with a = 1 and b = 10 -test lseq-4.3 {TIP examples} { +test lseq-4.3 {TIP examples} knownBug { set examples {# Examples from TIP-629 # --- Begin --- lseq 10 .. 1 @@ -474,7 +474,7 @@ test lseq-4.3 {TIP examples} { # # Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case -test lseq-4.4 {lseq corner case} -body { +test lseq-4.4 {lseq corner case} -constraints knownBug -body { set tcmd { set res {} set s [catch {lindex [lseq 10 100] 0} e] -- cgit v0.12 From 93e50d1448aba1ed4b5eb113ea5c9b5debee85dc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 28 Sep 2022 12:58:58 +0000 Subject: int -> ListSizeT, and a few more simplifications --- generic/tclArithSeries.c | 10 ++++++---- generic/tclListObj.c | 2 +- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 3974808..868ce74 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; } @@ -233,7 +235,7 @@ assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tc } *number; int tcl_number_type; - if (TclGetNumberFromObj(NULL, numberObj, (ClientData*)&number, &tcl_number_type) != TCL_OK) { + if (TclGetNumberFromObj(NULL, numberObj, (void **)&number, &tcl_number_type) != TCL_OK) { return; } if (useDoubles) { @@ -818,7 +820,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. */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 623689b..d18ad59 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2633,7 +2633,7 @@ TclLindexFlat( /* Handle ArithSeries as special case */ if (TclHasInternalRep(listObj,&tclArithSeriesType)) { Tcl_WideInt listLen = TclArithSeriesObjLength(listObj); - int index; + ListSizeT index; Tcl_Obj *elemObj = NULL; for (i=0 ; i Date: Wed, 28 Sep 2022 13:57:51 +0000 Subject: Fix wrong TclGetNumberFromObj() usage: this will crash if mp_int's are involved. Everywhere else in Tcl it is used correctly --- generic/tclArithSeries.c | 18 ++++++++---------- generic/tclCmdIL.c | 7 ++----- 2 files changed, 10 insertions(+), 15 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 868ce74..61b4a9b 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -229,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, (void **)&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; } } } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 5821a35..62ceeea 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4077,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; -- cgit v0.12