[Bug 2874678]: Don't leak bignums in [dict incr]...

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} {