diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 8 | ||||
| -rw-r--r-- | tests/dict.test | 36 |
3 files changed, 36 insertions, 14 deletions
@@ -1,3 +1,9 @@ +2009-10-08 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclDictObj.c (DictIncrCmd): [Bug 2874678]: Don't leak any + bignums when doing [dict incr] with a value. + * tests/dict.test (dict-19.3): Memory leak detection code. + 2009-10-07 Andreas Kupries <andreask@activestate.com> * generic/tclObj.c: [Bug 2871908]: Plug memory leaks of the diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index fc1cac1..d66a9b7 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.56.2.2 2009/01/06 16:07:17 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.56.2.3 2009/10/08 14:42:40 dkf Exp $ */ #include "tclInt.h" @@ -2151,6 +2151,12 @@ DictIncrCmd( if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); } else { + /* + * Remember to dispose with the bignum as we're not actually + * using it directly. [Bug 2874678] + */ + + mp_clear(&increment); Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]); } } else { diff --git a/tests/dict.test b/tests/dict.test index 5b08996..2d15909 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.24.2.2 2008/12/15 23:26:59 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.24.2.3 2009/10/08 14:42:40 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -18,6 +18,17 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc memtest script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} + } +} # Procedure to help check the contents of a dictionary. Note that we # can't just compare the string version because the order of the @@ -819,10 +830,6 @@ test dict-19.1 {memory bug} -setup { rename xxx {} } -result [dict create c d a b] test dict-19.2 {dict: testing for leaks} -setup { - proc getbytes {} { - set lines [split [memory info] "\n"] - lindex [lindex $lines 3] 3 - } # This test is made to stress object reference management proc stress {} { # A shared invalid dictinary @@ -927,18 +934,21 @@ test dict-19.2 {dict: testing for leaks} -setup { unset bepa } } -constraints memory -body { - set end [getbytes] - for {set i 0} {$i < 5} {incr i} { - stress - set tmp $end - set end [getbytes] + memtest { + stress } - expr {$end - $tmp} } -cleanup { - unset -nocomplain end i tmp - rename getbytes {} rename stress {} } -result 0 +test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body { + set d aDictVar; # Force interpreted [dict incr] + memtest { + dict incr $d aKey 0 + unset $d + } +} -cleanup { + unset d +} -result 0 test dict-20.1 {dict merge command} { dict merge |