diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 11 | ||||
| -rw-r--r-- | tests/coroutine.test | 24 |
3 files changed, 39 insertions, 2 deletions
@@ -1,3 +1,9 @@ +2011-04-11 Miguel Sofer <msofer@users.sf.net> + + * generic/tclBasic.c: + * tests/coroutine.test: insure that 'coroutine eval' runs the initial + command in the proper context, [Bug 3282869] + 2011-04-11 Jan Nijtmans <nijtmans@users.sf.net> * generic/tcl.h: fix for [Bug 3281728]: Tcl sources from 2011-04-06 do * unix/tcl.m4: not build on GCC9 (RH9) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f00864f..5019c86 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8866,6 +8866,7 @@ TclNRCoroutineObjCmd( const char *fullName, *procName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_DString ds; + Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?"); @@ -8952,7 +8953,7 @@ TclNRCoroutineObjCmd( } /* - * Save the base context. + * Create the base context. */ corPtr->running.framePtr = iPtr->rootFramePtr; @@ -8972,13 +8973,19 @@ TclNRCoroutineObjCmd( corPtr->callerEEPtr = iPtr->execEnvPtr; corPtr->eePtr->corPtr = corPtr; + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); - iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr; + iPtr->lookupNsPtr = lookupNsPtr; Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0); + + SAVE_CONTEXT(corPtr->running); + RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* diff --git a/tests/coroutine.test b/tests/coroutine.test index 4d7e3de..bc72017 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -435,6 +435,30 @@ test coroutine-4.5 {bug #2724403} -constraints {memory} \ unset i ns start end } -result 0 +test coroutine-4.6 {compile context, bug #3282869} -setup { + unset ::x + proc f x { + coroutine D eval {yield X$x;yield Y} + } +} -body { + f 12 +} -cleanup { + rename f {} +} -returnCodes error -match glob -result {can't read *} + +test coroutine-4.7 {compile context, bug #3282869} -setup { + proc f x { + coroutine D eval {yield X$x;yield Y$x} + } +} -body { + set ::x 15 + set ::x [f 12] + D +} -cleanup { + unset ::x + rename f {} +} -result YX15 + test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \ -setup { proc nestedYield {{val {}}} { |