summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgriffin <briang42@easystreet.net>2022-09-30 20:27:20 (GMT)
committergriffin <briang42@easystreet.net>2022-09-30 20:27:20 (GMT)
commit5d3af5f62717c5ddd028c528ff1f89d481b5e63d (patch)
tree5ae15612e4096aff01585ce13e95a09941f1dea1
parentbec96305308d0c234215d25b194f1ff8417dc8b4 (diff)
parentb01f9536cb1fe19d6b97c9a81b4dac4fb98dd5dd (diff)
downloadtcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.zip
tcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.tar.gz
tcl-5d3af5f62717c5ddd028c528ff1f89d481b5e63d.tar.bz2
Fix refCount issues related to lseq
-rwxr-xr-xgeneric/tclArithSeries.c6
-rw-r--r--generic/tclCmdAH.c7
-rw-r--r--generic/tclListObj.c2
-rw-r--r--tests/lseq.test14
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: