summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-10-08 14:42:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-10-08 14:42:40 (GMT)
commit0d31e4cefc735abf4b5eb232c3b89effa9ebc3aa (patch)
treed6aee156688cbe239524349e78d8f2f79a79340a
parent817534697915bca720f02388c1e9b6a0e72718c0 (diff)
downloadtcl-0d31e4cefc735abf4b5eb232c3b89effa9ebc3aa.zip
tcl-0d31e4cefc735abf4b5eb232c3b89effa9ebc3aa.tar.gz
tcl-0d31e4cefc735abf4b5eb232c3b89effa9ebc3aa.tar.bz2
[Bug 2874678]: Don't leak bignums in [dict incr]...
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclDictObj.c8
-rw-r--r--tests/dict.test36
3 files changed, 36 insertions, 14 deletions
diff --git a/ChangeLog b/ChangeLog
index 53932ec..99b598d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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