diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCompile.h | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 46 | ||||
| -rw-r--r-- | tests/nre.test | 24 |
4 files changed, 54 insertions, 26 deletions
@@ -1,3 +1,9 @@ +2010-01-21 Miguel Sofer <msofer@users.sf.net> + + * generic/tclCompile.h: NRE-enable direct eval on BC spoilage + * generic/tclExecute.c: [Bug 2910748] + * tests/nre.test: + 2010-01-19 Donal K. Fellows <dkf@users.sf.net> * doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict diff --git a/generic/tclCompile.h b/generic/tclCompile.h index a41e094..3c514d0 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.120 2010/01/03 20:29:11 msofer Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.121 2010/01/21 17:23:49 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -343,6 +343,8 @@ typedef struct CompileEnv { #define TCL_BYTECODE_RESOLVE_VARS 0x0002 +#define TCL_BYTECODE_RECOMPILE 0x0004 + typedef struct ByteCode { TclHandle interpHandle; /* Handle for interpreter containing the * compiled code. Commands and their compile diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e553356..ffb8242 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.468 2009/12/13 17:11:47 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.469 2010/01/21 17:23:49 msofer Exp $ */ #include "tclInt.h" @@ -2353,32 +2353,25 @@ TclExecuteByteCode( } else { const char *bytes; int length = 0, opnd; - Tcl_Obj *newObjResultPtr; - - bytes = GetSrcInfoForPc(pc, codePtr, &length); - DECACHE_STACK_INFO(); - TRESULT = Tcl_EvalEx(interp, bytes, length, 0); - CACHE_STACK_INFO(); - if (TRESULT != TCL_OK) { - cleanup = 0; - if (TRESULT == TCL_ERROR) { - /* - * Tcl_EvalEx already did the task of logging the error to - * the stack trace for us, so set a flag to prevent the - * TEBC exception handling machinery from trying to do it - * again. See test execute-8.4. [Bug 2037338] - */ + + /* + * We used to switch to direct eval; for NRE-awareness we now + * compile and eval the command so that this evaluation does not + * add a new TEBC instance [Bug 2910748] + */ + - iPtr->flags |= ERR_ALREADY_LOGGED; - } - goto processExceptionReturn; + if (TclInterpReady(interp) == TCL_ERROR) { + TRESULT = TCL_ERROR; + goto checkForCatch; } + + codePtr->flags |= TCL_BYTECODE_RECOMPILE; + bytes = GetSrcInfoForPc(pc, codePtr, &length); opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_GetObjResult(interp); - TclNewObj(newObjResultPtr); - Tcl_IncrRefCount(newObjResultPtr); - iPtr->objResultPtr = newObjResultPtr; - NEXT_INST_F(opnd, 0, -1); + pc += (opnd-1); + PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + goto instEvalStk; } case INST_NOP: @@ -2675,6 +2668,7 @@ TclExecuteByteCode( int objc, pcAdjustment; Tcl_Obj **objv; + instEvalStk: case INST_EVAL_STK: { /* * Moved here to support transforming the eval of objects to a @@ -2915,6 +2909,10 @@ TclExecuteByteCode( nonRecursiveCallReturn: + if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { + iPtr->flags |= ERR_ALREADY_LOGGED; + codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; + } NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); iPtr->cmdFramePtr = bcFramePtr->nextPtr; TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); diff --git a/tests/nre.test b/tests/nre.test index 2c91e7a..dcc2180 100644 --- a/tests/nre.test +++ b/tests/nre.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: nre.test,v 1.11 2009/06/25 19:24:16 dgp Exp $ +# RCS: @(#) $Id: nre.test,v 1.12 2010/01/21 17:23:49 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -280,6 +280,28 @@ test nre-7.7 {[eval] is not recursive} -setup { testnrelevels } -result {{0 2 2 1} 0} +test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup { + proc foo args {} + foo + coroutine bar apply {{} { + yield + proc foo args {return ok} + while 1 { + yield [incr i] + foo + } + }} +} -body { + # if switching to plain eval is not nre aware, this will cause a "cannot + # yield" error + + list [bar] [bar] [bar] +} -cleanup { + rename bar {} + rename foo {} +} -result {1 2 3} + + test nre-8.1 {nre and {*}} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the bottomPtr. This crashes on failure. |