summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-10-08 14:37:36 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-10-08 14:37:36 (GMT)
commit96e6cf13bf6f34d470255420538843d45d04aed9 (patch)
tree0e19ed6fc085b82d76297784349b278f616bb5d3
parent4b5432b3e850af2f49c5d0d58d48a3736dcf0012 (diff)
downloadtcl-96e6cf13bf6f34d470255420538843d45d04aed9.zip
tcl-96e6cf13bf6f34d470255420538843d45d04aed9.tar.gz
tcl-96e6cf13bf6f34d470255420538843d45d04aed9.tar.bz2
[Bug 2874678]: Don't leak bignums in [dict incr]...
-rw-r--r--ChangeLog41
-rw-r--r--generic/tclDictObj.c8
-rw-r--r--tests/dict.test37
3 files changed, 52 insertions, 34 deletions
diff --git a/ChangeLog b/ChangeLog
index dbc0860..a12bdc8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,15 +1,20 @@
+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
- objThreadMap and lineCLPtr hashtables. Also make the names of the
- continuation line information initialization and finalization
- functions more consistent. Patch supplied by Joe Mistachkin
- <joe@mistachkin.com>.
+ * generic/tclObj.c: [Bug 2871908]: Plug memory leaks of objThreadMap
+ and lineCLPtr hashtables. Also make the names of the continuation
+ line information initialization and finalization functions more
+ consistent. Patch supplied by Joe Mistachkin <joe@mistachkin.com>.
- * generic/tclIORChan.c (ErrnoReturn): Replace the hardwired
- constant 11 with the proper errno define, EAGAIN. What was I
- thinking ? The BSD's have a different errno assignment and break
- with the hardwired number. Reported by emiliano on the chat.
+ * generic/tclIORChan.c (ErrnoReturn): Replace hardwired constant 11
+ with proper errno #define, EAGAIN. What was I thinking? The BSD's have
+ a different errno assignment and break with the hardwired number.
+ Reported by emiliano on the chat.
2009-10-06 Don Porter <dgp@users.sourceforge.net>
@@ -19,7 +24,7 @@
their intreps and require reparsing. Thanks to Ashok Nadkarni for
reporting the problem.
- * generic/tclTomMathInt.h (new): Public header tclTomMath.h had
+ * generic/tclTomMathInt.h (new): Public header tclTomMath.h had
* generic/tclTomMath.h: dependence on private headers, breaking use
* generic/tommath.h: by extensions [Bug 1941434].
@@ -41,14 +46,14 @@
* library/tzdata/Asia/Gaza:
* library/tzdata/Asia/Karachi:
* library/tzdata/Pacific/Apia: Olson's tzdata2009n.
-
+
2009-09-29 Don Porter <dgp@users.sourceforge.net>
- * generic/tclDictObj.c: Updated freeIntRepProc routines so
- * generic/tclExecute.c: that they set the typePtr field to
- * generic/tclIO.c: NULL so that the Tcl_Obj is not left
- * generic/tclIndexObj.c: in an inconsistent state.
- * generic/tclInt.h: [Bug 2857044]
+ * generic/tclDictObj.c: [Bug 2857044]: Updated freeIntRepProc
+ * generic/tclExecute.c: routines so that they set the typePtr
+ * generic/tclIO.c: field to NULL so that the Tcl_Obj is
+ * generic/tclIndexObj.c: not left in an inconsistent state.
+ * generic/tclInt.h:
* generic/tclListObj.c:
* generic/tclNamesp.c:
* generic/tclOOCall.c:
@@ -124,7 +129,7 @@
2009-09-16 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
* generic/tclObj.c: Extended ::tcl::unsupported::representation.
-
+
2009-09-11 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: Completed the NR-enabling of [subst].
@@ -148,7 +153,7 @@
2009-09-07 Don Porter <dgp@users.sourceforge.net>
* generic/tclParse.c: [Bug 2850901]: Corrected line counting error
- * tests/into.test: in multi-command script substitutions.
+ * tests/into.test: in multi-command script substitutions.
2009-09-07 Daniel Steffen <das@users.sourceforge.net>
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index d30a769..32a5cb0 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.78 2009/09/30 03:11:24 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.79 2009/10/08 14:37:36 dkf Exp $
*/
#include "tclInt.h"
@@ -2165,6 +2165,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 b83a5ed..b4f0f0e 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.32 2008/12/15 23:09:24 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.33 2009/10/08 14:37:36 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
@@ -818,15 +829,9 @@ test dict-19.1 {memory bug} {
dict get $successors x
}}
} [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
- }
-} -constraints memory -body {
+test dict-19.2 {dict: testing for leaks} -constraints memory -body {
# This test is made to stress object reference management
- set end [getbytes]
- for {set i 0} {$i < 5} {incr i} {
+ memtest {
apply {{} {
# A shared invalid dictinary
set apa {a {}b c d}
@@ -929,14 +934,16 @@ test dict-19.2 {dict: testing for leaks} -setup {
trace remove variable bepa write {error hej}
unset bepa
}}
- set tmp $end
- set end [getbytes]
}
- expr {$end - $tmp}
+} -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 -nocomplain end i tmp
- rename getbytes {}
-# rename stress {}
+ unset d
} -result 0
test dict-20.1 {dict merge command} {