fix done optimization (TCL_EVAL_DISCARD_RESULT) for nested call - supply and reset discard result flag in registering TEBC-callback,

because it is applicable for this call only, and should not affect all the nested invocations may return result (added tests covering that).

3 files changed, 39 insertions, 7 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d16baa9..8a2a3c7 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4556,7 +4556,6 @@ Tcl_TimeRateObjCmd(
 		((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT;
 		result = TclNRExecuteByteCode(interp, codePtr);
 		result = TclNRRunCallbacks(interp, result, rootPtr);
-		((Interp *)interp)->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
 	    } else {			/* eval */
 		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
 	    }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6959c00..9f029f1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2086,7 +2086,14 @@ TclNRExecuteByteCode(
      */
 
     TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
-	    /* cleanup */ INT2PTR(0), NULL);
+	    /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags));
+
+    /* 
+     * Reset discard result flag - because it is applicable for this call only,
+     * and should not affect all the nested invocations may return result.
+     */
+    iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
+
     return TCL_OK;
 }
 
@@ -2142,6 +2149,7 @@ TEBCresume(
 #define auxObjList	(TD->auxObjList)
 #define catchTop	(TD->catchTop)
 #define codePtr		(TD->codePtr)
+#define curEvalFlags	PTR2INT(data[3])  /* calling iPtr->evalFlags */
 
     /*
      * Globals: variables that store state, must remain valid at all times.
@@ -2625,7 +2633,7 @@ TEBCresume(
     case INST_DONE:
 	if (tosPtr > initTosPtr) {
 
-	    if ((iPtr->evalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) {
+	    if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) {
 		/* simulate pop & fast done (like it does continue in loop) */
 		TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
 		objPtr = POP_OBJECT();
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 1157ada..5ee2d23 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -358,6 +358,19 @@ test cmdMZ-5.7.1 {Tcl_TimeObjCmd: return from time} {
     proc r1 {} {upvar x x; time {incr x; return "r1"; incr x} 10}
     list [r1] $x
 } {r1 1}
+test cmdMZ-5.8 {Tcl_TimeObjCmd: done optimization: nested call of self inside time (if compiled)} {
+    set x [set y 0]
+    set m1 {
+	if {[incr x] <= 5} {
+	    # nested call should return result, so covering that:
+	    if {![string is integer -strict [eval $m1]]} {error unexpected}
+	}
+	# increase again (no "continue" from nested call):
+	incr x
+    }
+    time {incr y; eval $m1} 5
+    list $y $x
+} {5 20}
 
 test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} {
     list [catch {timerate} msg] $msg
@@ -420,10 +433,10 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
 test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} {
     set m1 [timerate {continue; return -code error "unexpected"} 1000 10]
     list \
-    [expr {[lindex $m1 0] < 1000}] \
-    [expr {[lindex $m1 2] == 10}] \
-    [expr {[lindex $m1 4] > 1000}] \
-    [expr {[lindex $m1 6] < 100}]
+	[expr {[lindex $m1 0] < 1000}] \
+	[expr {[lindex $m1 2] == 10}] \
+	[expr {[lindex $m1 4] > 1000}] \
+	[expr {[lindex $m1 6] < 100}]
 } {1 1 1 1}
 test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
     set m1 [timerate {} 1000 5];	# max-count wins
@@ -444,6 +457,18 @@ test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} {
     timerate $m1 1000 10
     if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop
 } ok
+test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self inside timerate} {
+    set x 0
+    set m1 {
+	if {[incr x] <= 5} {
+	    # nested call should return result, so covering that:
+	    if {![string is integer -strict [eval $m1]]} {error unexpected}
+	}
+	# increase again (no "continue" from nested call):
+	incr x
+    }
+    list [lindex [timerate $m1 1000 5] 2] $x
+} {5 20}
 
 # The tests for Tcl_WhileObjCmd are in while.test