* generic/tclBasic.c: Fix lerak of coroutines on namespace

	* generic/tclCompile.h:  deletion, [Bug 2724403]. Added a test
	* generic/tclNamesp.c:   for this leak, and also a test for
	* tests/coroutine.test:  leaks on namespace deletion.
	* tests/namespace.test:

6 files changed, 90 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index d401823..ef0bcdf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2010-01-03  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic.c:    Fix lerak of coroutines on namespace
+	* generic/tclCompile.h:  deletion, [Bug 2724403]. Added a test
+	* generic/tclNamesp.c:   for this leak, and also a test for
+	* tests/coroutine.test:  leaks on namespace deletion.
+	* tests/namespace.test:
+	
+	* library/init.tcl (unknown): [Bug 2824981]: Fix infinite recursion of
+	::unknown when [set] is undefined.
+
 2009-12-30  Donal K. Fellows  <dkf@users.sf.net>
 
 	* library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 43f484b..254760d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.437 2009/12/24 06:55:25 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.438 2010/01/03 20:29:11 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -137,7 +137,6 @@ static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
 			    Tcl_Obj *const objv[], int lookup);
 static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
 			    int actual, Tcl_Obj *const *objv);
-static Tcl_ObjCmdProc	NRInterpCoroutine;
 static Tcl_NRPostProc	NRCoroutineCallerCallback;
 static Tcl_NRPostProc	NRCoroutineExitCallback;
 static Tcl_NRPostProc	NRRunObjProc;
@@ -8674,7 +8673,7 @@ NRCoroutineExitCallback(
     return result;
 }
 
-static int
+int
 NRInterpCoroutine(
     ClientData clientData,
     Tcl_Interp *interp,		/* Current interpreter. */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 25dec86..a41e094 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.119 2009/09/04 17:33:11 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.120 2010/01/03 20:29:11 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -858,6 +858,7 @@ typedef struct {
 
 MODULE_SCOPE Tcl_NRPostProc   NRCallTEBC;
 MODULE_SCOPE Tcl_NRPostProc   NRCommand;
+MODULE_SCOPE Tcl_ObjCmdProc   NRInterpCoroutine;
 
 #define TCL_NR_BC_TYPE         0
 #define TCL_NR_ATEXIT_TYPE     1
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 507007d..f8ee460 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.198 2009/12/13 17:11:47 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.199 2010/01/03 20:29:11 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -956,7 +956,31 @@ Tcl_DeleteNamespace(
     Namespace *globalNsPtr = (Namespace *)
 	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
     Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Command *cmdPtr;
+
+    /*
+     * Delete all coroutine commands now: break the circular ref cycle between
+     * the namespace and the coroutine command [Bug 2724403]. This code is
+     * essentially duplicated in TclTeardownNamespace() for all other
+     * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
+     *
+     * NOTE: we could avoid traversing the ns's command list by keeping a
+     * separate list of coros.
+     */
 
+    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+	    entryPtr != NULL;) {
+	cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+	if (cmdPtr->nreProc == NRInterpCoroutine) {
+	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command)cmdPtr);
+	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);	    
+	} else {
+	    entryPtr = entryPtr->nextPtr;
+	}
+    }    
+    
+    
     /*
      * If the namespace has associated ensemble commands, delete them first.
      * This leaves the actual contents of the namespace alone (unless they are
diff --git a/tests/coroutine.test b/tests/coroutine.test
index b4019d4..caa1d0a 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.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: coroutine.test,v 1.10 2009/12/19 14:22:00 msofer Exp $
+# RCS: @(#) $Id: coroutine.test,v 1.11 2010/01/03 20:29:12 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -17,6 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 testConstraint testnrelevels [llength [info commands testnrelevels]]
+testConstraint memory [llength [info commands memory]]
 
 set lambda [list {{start 0} {stop 10}} {
     # init
@@ -378,6 +379,7 @@ test coroutine-4.2 {bug #2093188} -setup {
     rename bar {}
     unset ::res
 } -result {{} 3 {{v {} read} {v {} unset}}}
+
 test coroutine-4.3 {bug #2093947} -setup {
     proc foo {} {
 	set v 1
@@ -412,6 +414,29 @@ test coroutine-4.4 {bug #2917627: cmd resolution} -setup {
     namespace delete b
 } -result local
 
+test coroutine-4.5 {bug #2724403} -constraints {memory} \
+-setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set ns ::y$i
+	namespace eval $ns {}
+	proc ${ns}::start {} {yield; puts hello}
+	coroutine ${ns}::run ${ns}::start
+	namespace delete $ns
+	set start $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $start}]
+} -cleanup {
+    rename getbytes {}
+    unset i ns start end
+} -result 0
+
 test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
 -setup {
     proc nestedYield {{val {}}} {
diff --git a/tests/namespace.test b/tests/namespace.test
index 5feaf91..889f945 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,13 +11,15 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.76 2009/01/09 15:00:27 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.77 2010/01/03 20:29:12 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+testConstraint memory [llength [info commands memory]]
+
 #
 # REMARK: the tests for 'namespace upvar' are not done here. They are to be
 # found in the file 'upvar.test'.
@@ -2853,6 +2855,27 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
     1 {wrong # args: should be "ns v x z2 a2"}\
     0 {2 v v2}}
 
+test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
+-setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set ns ::y$i
+	namespace eval $ns {}
+	namespace delete $ns
+	set start $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $start}]
+} -cleanup {
+    rename getbytes {}
+    unset i ns start end
+} -result 0
+
 # cleanup
 catch {rename cmd1 {}}
 catch {unset l}