diff options
| -rw-r--r-- | generic/tclExecute.c | 3 | ||||
| -rw-r--r-- | tests/var.test | 28 |
2 files changed, 31 insertions, 0 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d12a25c..ae11f7a 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4181,6 +4181,9 @@ TEBCresume( if (!TclIsVarUndefined(varPtr)) { TclDecrRefCount(varPtr->value.objPtr); + TclSetVarUndefined(varPtr); + TclClearVarNamespaceVar(varPtr); + TclCleanupVar(varPtr, arrayPtr); } else if (flags & TCL_LEAVE_ERR_MSG) { goto slowUnsetArray; } diff --git a/tests/var.test b/tests/var.test index 7ff394e..0531746 100644 --- a/tests/var.test +++ b/tests/var.test @@ -25,6 +25,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] +testConstraint memory [llength [info commands memory]] catch {rename p ""} catch {namespace delete test_ns_var} @@ -894,6 +895,33 @@ test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup { rename linenumber {} } -result 1 +test var-22.0 {leak in array element unset: Bug a3309d01db} -setup { + proc getbytes {} { + lindex [split [memory info] \n] 3 3 + } + proc doit k { + variable A + set A($k) {} + foreach n [array names A] { + if {$n <= $k-1} { + unset A($n) + } + } + } +} -constraints memory -body { + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + doit $i + set tmp $end + set end [getbytes] + } + set leakedBytes [expr {$end - $tmp}] +} -cleanup { + array unset A + rename getbytes {} + rename doit {} +} -result 0 + catch {namespace delete ns} catch {unset arr} |