diff options
author | griffin <briang42@easystreet.net> | 2022-09-30 20:27:20 (GMT) |
---|---|---|
committer | griffin <briang42@easystreet.net> | 2022-09-30 20:27:20 (GMT) |
commit | 5d3af5f62717c5ddd028c528ff1f89d481b5e63d (patch) | |
tree | 5ae15612e4096aff01585ce13e95a09941f1dea1 | |
parent | bec96305308d0c234215d25b194f1ff8417dc8b4 (diff) | |
parent | b01f9536cb1fe19d6b97c9a81b4dac4fb98dd5dd (diff) | |
download | tcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.zip tcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.tar.gz tcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.tar.bz2 |
Fix refCount issues related to lseq
-rwxr-xr-x | generic/tclArithSeries.c | 6 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 7 | ||||
-rw-r--r-- | generic/tclListObj.c | 2 | ||||
-rw-r--r-- | tests/lseq.test | 14 |
4 files changed, 21 insertions, 8 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 61b4a9b..ee201fa 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -392,6 +392,7 @@ TclArithSeriesObjStep( } else { *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); } + Tcl_IncrRefCount(*stepObj); return TCL_OK; } @@ -436,6 +437,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele } else { *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); } + Tcl_IncrRefCount(*elementObj); return TCL_OK; } @@ -722,11 +724,8 @@ 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))) { @@ -857,7 +856,6 @@ TclArithSeriesGetElements( } return TCL_ERROR; } - Tcl_IncrRefCount(objv[i]); } } } else { diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 07541bd..3048e82 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -3027,6 +3027,13 @@ 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/tclListObj.c b/generic/tclListObj.c index d18ad59..598ff6f 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2641,7 +2641,6 @@ TclLindexFlat( } if (i==0) { TclArithSeriesObjIndex(listObj, index, &elemObj); - Tcl_IncrRefCount(elemObj); } else if (index > 0) { Tcl_DecrRefCount(elemObj); TclNewObj(elemObj); @@ -3304,7 +3303,6 @@ SetListFromAny( if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) { return TCL_ERROR; } - Tcl_IncrRefCount(elemPtrs[j]);/* Since list now holds ref to it. */ } } else { diff --git a/tests/lseq.test b/tests/lseq.test index 518a7bb..7daa59c 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -223,6 +223,8 @@ test lseq-3.1 {experiement} { if {$ans eq {}} { set ans OK } + unset factor + unset l set ans } {OK} @@ -376,13 +378,18 @@ test lseq-3.26 {lsort shimmer} arithSeriesShimmer { list ${rep-before} $lexical_sort ${rep-after} } {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries} -test lseq-3.27 {lreplace shimmer} arithSeriesShimmer { +test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body { set r [lseq 15 0] set rep-before [lindex [tcl::unsupported::representation $r] 3] set lexical_sort [lreplace $r 3 5 A B C] set rep-after [lindex [tcl::unsupported::representation $r] 3] list ${rep-before} $lexical_sort ${rep-after} -} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} +} -cleanup { + unset r + unset rep-before + unset lexical_sort + unset rep-after +} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} test lseq-3.28 {lreverse bug in ArithSeries} {} { set r [lseq -5 17 3] @@ -499,11 +506,14 @@ test lseq-4.4 {lseq corner case} -body { test lseq-4.5 {lindex off by one} -body { lappend res [eval {lindex [lseq 1 4] end}] lappend res [eval {lindex [lseq 1 4] end-1}] +} -cleanup { + unset res } -result {4 3} # cleanup ::tcltest::cleanupTests + return # Local Variables: |