Subject: [a90d9331bc]: must not crash when yieldto called in vanishing namespace

From: dkf <[email-masked]>
Date: Wed, 22 Jan 2014 09:07:45 +0000

---
 generic/tclBasic.c   | 18 ++++------
 generic/tclExecute.c | 11 +++++++
 tests/coroutine.test | 92 +++++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 105 insertions(+), 16 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e355229..cb9428c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8431,11 +8431,13 @@ TclNRYieldToObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * Add the tailcall in the caller env, then just yield.
-     *
-     * This is essentially code from TclNRTailcallObjCmd
-     */
+    if (((Namespace *) TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"yieldto called in deleted namespace", -1));
+        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		NULL);
+        return TCL_ERROR;
+    }
 
     /*
      * Add the tailcall in the caller env, then just yield.
@@ -8444,15 +8446,9 @@ TclNRYieldToObjCmd(
      */
 
     listPtr = Tcl_NewListObj(objc, objv);
-
     nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
-	    || (nsPtr != ns1Ptr)) {
-	Tcl_Panic("yieldto failed to find the proper namespace");
-    }
     TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
 
-
     /*
      * Add the callback in the caller's env, then instruct TEBC to yield.
      */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 575f227..6749120 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2542,6 +2542,17 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
+	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
+		    O2S(valuePtr)));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yieldto called in deleted namespace", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
 
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceExec >= 2) {
diff --git a/tests/coroutine.test b/tests/coroutine.test
index a360fd5..05b58c9 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -1,4 +1,4 @@
-# Commands covered:  coroutine, yield, [info coroutine]
+# Commands covered:  coroutine, yield, yieldto, [info coroutine]
 #
 # This file contains a collection of tests for experimental commands that are
 # found in ::tcl::unsupported. The tests will migrate to normal test files
@@ -612,7 +612,6 @@ test coroutine-7.3 {yielding between coroutines} -body {
 } -cleanup {
     catch {rename juggler ""}
 } -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
-
 test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
     proc foo {a b} {catch yield; return 1}
 } -cleanup {
@@ -620,7 +619,6 @@ test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
 } -body {
     coroutine demo lsort -command foo {a b}
 } -result {b a}
-
 test coroutine-7.5 {return codes} {
     set result {}
     foreach code {0 1 2 3 4 5} {
@@ -628,14 +626,12 @@ test coroutine-7.5 {return codes} {
     }
     set result
 } {0 1 2 3 4 5}
-
 test coroutine-7.6 {Early yield crashes} {
     proc foo args {}
     trace add execution foo enter {catch yield}
     coroutine demo foo
     rename foo {}
 } {}
-
 test coroutine-7.7 {Bug 2486550} -setup {
     interp hide {} yield
 } -body {
@@ -644,6 +640,92 @@ test coroutine-7.7 {Bug 2486550} -setup {
     demo
     interp expose {} yield
 } -result ok
+test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
 
 
 # cleanup
-- 
cgit v0.12