Tcl Source Code

Artifact [b3c9771764]
Login

Artifact b3c97717647bd260079ba993faddebf1242ba81c:

Attachment "2910748.diff" to ticket [2910748fff] added by msofer 2010-01-19 22:34:04.
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.468
diff -u -r1.468 tclExecute.c
--- generic/tclExecute.c	13 Dec 2009 17:11:47 -0000	1.468
+++ generic/tclExecute.c	17 Jan 2010 13:27:27 -0000
@@ -2353,32 +2353,24 @@
 	} 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;
 	    }
+	    
+	    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 +2667,7 @@
 	int objc, pcAdjustment;
 	Tcl_Obj **objv;
 
+	instEvalStk:
 	case INST_EVAL_STK: {
 	    /*
 	     * Moved here to support transforming the eval of objects to a
Index: tests/nre.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/nre.test,v
retrieving revision 1.11
diff -u -r1.11 nre.test
--- tests/nre.test	25 Jun 2009 19:24:16 -0000	1.11
+++ tests/nre.test	17 Jan 2010 13:27:27 -0000
@@ -280,6 +280,28 @@
     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.