From 00199ad335823ec6b18983d1188f70b0b065b25e Mon Sep 17 00:00:00 2001 From: griffin Date: Tue, 4 Oct 2022 20:15:38 +0000 Subject: Fix some bugs in lseq --- generic/tclArithSeries.c | 9 +++++++-- generic/tclCmdAH.c | 17 +++++------------ generic/tclExecute.c | 7 ++++++- generic/tclListObj.c | 8 ++++---- tests/lseq.test | 2 +- 5 files changed, 23 insertions(+), 20 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index ee201fa..6a02caa 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -392,7 +392,6 @@ TclArithSeriesObjStep( } else { *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); } - Tcl_IncrRefCount(*stepObj); return TCL_OK; } @@ -437,7 +436,6 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele } else { *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); } - Tcl_IncrRefCount(*elementObj); return TCL_OK; } @@ -724,8 +722,11 @@ TclArithSeriesObjRange( } TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj); + Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj); + Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + Tcl_IncrRefCount(stepObj); if (Tcl_IsShared(arithSeriesPtr) || ((arithSeriesPtr->refCount > 1))) { @@ -856,6 +857,7 @@ TclArithSeriesGetElements( } return TCL_ERROR; } + Tcl_IncrRefCount(objv[i]); } } } else { @@ -912,8 +914,11 @@ TclArithSeriesObjReverse( len = arithSeriesRepPtr->len; TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj); + Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj); + Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + Tcl_IncrRefCount(stepObj); if (isDouble) { Tcl_GetDoubleFromObj(NULL, startObj, &dstart); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 3048e82..a5c5330 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2866,13 +2866,13 @@ EachloopCmd( /* Values */ if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) { /* Special case for Arith Series */ - statePtr->vCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); - if (statePtr->vCopyList[i] == NULL) { + statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); + if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; } /* Don't compute values here, wait until the last momement */ - statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->vCopyList[i]); + statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]); } else { /* List values */ statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); @@ -3005,12 +3005,12 @@ ForeachAssignments( Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; inumLists ; i++) { - int isarithseries = TclHasInternalRep(statePtr->vCopyList[i],&tclArithSeriesType); + int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType); for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { if (isarithseries) { - if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &valuePtr) != TCL_OK) { + if (TclArithSeriesObjIndex(statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", (statePtr->resultList != NULL ? "lmap" : "foreach"), @@ -3027,13 +3027,6 @@ ForeachAssignments( varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v], NULL, valuePtr, TCL_LEAVE_ERR_MSG); - if (isarithseries) { - /* arith values have implicit reference - ** Make sure value is cleaned up when var goes away - */ - Tcl_DecrRefCount(valuePtr); - } - if (varValuePtr == NULL) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fa0dfa2..7c7bbfd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4883,6 +4883,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } + Tcl_IncrRefCount(objResultPtr); // reference held here goto lindexDone; } @@ -5187,7 +5188,11 @@ TEBCresume( */ do { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + if (isArithSeries) { + TclArithSeriesObjIndex(value2Ptr, i, &o); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } if (o != NULL) { s2 = TclGetStringFromObj(o, &s2len); } else { diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 598ff6f..62bc162 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1369,6 +1369,9 @@ TclListObjCopy( Tcl_Obj *copyObj; if (!TclHasInternalRep(listObj, &tclListType)) { + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + return TclArithSeriesObjCopy(interp, listObj); + } if (SetListFromAny(interp, listObj) != TCL_OK) { return NULL; } @@ -1943,10 +1946,6 @@ Tcl_ListObjIndex( Tcl_Obj **elemObjs; ListSizeT numElems; - if (TclHasInternalRep(listObj,&tclArithSeriesType)) { - return TclArithSeriesObjIndex(listObj, index, objPtrPtr); - } - /* * TODO * Unlike the original list code, this does not optimize for lindex'ing @@ -2642,6 +2641,7 @@ TclLindexFlat( if (i==0) { TclArithSeriesObjIndex(listObj, index, &elemObj); } else if (index > 0) { + /* ArithSeries cannot be a list of lists */ Tcl_DecrRefCount(elemObj); TclNewObj(elemObj); Tcl_IncrRefCount(elemObj); diff --git a/tests/lseq.test b/tests/lseq.test index 7daa59c..2e5d7e1 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { testConstraint arithSeriesDouble 1 testConstraint arithSeriesShimmer 1 -testConstraint arithSeriesShimmerOk 0 +testConstraint arithSeriesShimmerOk 1 ## Arg errors test lseq-1.1 {error cases} -body { -- cgit v0.12 From 3cb6c489a3c0515c7b3aade0aaa139e637400559 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Oct 2022 06:41:28 +0000 Subject: Missing error-check in Tcl_GetWideIntFromObj (backported from 9.0, was already fixed there) --- generic/tclArithSeries.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 6a02caa..11a4254 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -306,7 +306,9 @@ TclNewArithSeriesObj( assignNumber(useDoubles, &end, &dend, endObj); } if (lenObj) { - Tcl_GetWideIntFromObj(NULL, lenObj, &len); + if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) { + return TCL_ERROR; + } } if (startObj && endObj) { @@ -339,7 +341,7 @@ TclNewArithSeriesObj( } } - if (len > ListSizeT_MAX) { + if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); -- cgit v0.12