diff options
| -rw-r--r-- | generic/tclBasic.c | 18 | ||||
| -rw-r--r-- | generic/tclExecute.c | 11 | ||||
| -rw-r--r-- | 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 |