From 9a08b056c6086eb886da58e32ce8efae27b13b25 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Thu, 29 Mar 2007 19:22:06 +0000
Subject: 	* generic/tclProc.c (Tcl_ApplyObjCmd): 	* tests/apply.test
 (9.3): Fixed Tcl_Obj leak on error return; an 	unneeded ref to lambdaPtr was
 being set and not released on an 	error return path.

---
 ChangeLog         |  7 +++++++
 generic/tclProc.c |  6 +-----
 tests/apply.test  | 20 +++++++++++++++++++-
 3 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8bd4d2b..7b80f6a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-03-29  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclProc.c (Tcl_ApplyObjCmd):
+	* tests/apply.test (9.3): Fixed Tcl_Obj leak on error return; an
+	unneeded ref to lambdaPtr was being set and not released on an
+	error return path.
+
 2007-03-28  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCmdMZ.c (STR_REVERSE):	Implement the actual
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 92e81af..9d2c2bb 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.108 2006/11/28 22:20:29 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.109 2007/03/29 19:22:07 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2383,7 +2383,6 @@ Tcl_ApplyObjCmd(
      */
 
     cmd.clientData = (ClientData) lambdaPtr;
-    Tcl_IncrRefCount (lambdaPtr);
  
     /*
      * Find the namespace where this lambda should run, and push a call frame
@@ -2424,9 +2423,6 @@ Tcl_ApplyObjCmd(
 	iPtr->ensembleRewrite.numInsertedObjs = 0;
     }
 
-    /* TIP #280 Undo the reference held inside of 'cmd, see HACK above. */
-    Tcl_DecrRefCount (lambdaPtr);
-
     return result;    
 }
 
diff --git a/tests/apply.test b/tests/apply.test
index 10131ce..93c77a2 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: apply.test,v 1.9 2006/10/28 22:48:43 dkf Exp $
+# RCS: @(#) $Id: apply.test,v 1.10 2007/03/29 19:22:08 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -301,6 +301,24 @@ test apply-9.2 {leaking internal rep} -setup {
 } -cleanup {
     rename getbytes {}
 } -result 0
+test apply-9.3 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set x [list {} {set a 1} ::NS::THAT::DOES::NOT::EXIST]
+	catch {::apply $x}
+	set x {}
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+} -result 0
 
 # Tests for the avoidance of recompilation
 
-- 
cgit v0.12