From 70c2b0e817830a7baec1796e3dc095fba8b7f6f8 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sun, 20 Jun 2021 22:47:14 +0000
Subject: Fix for [f9800d52bd61f240], vwait is not NRE-enabled, and yieldto
 cannot find the right splicing spot

---
 generic/tclBasic.c   | 24 +++++++++++++++++++++++-
 generic/tclExecute.c |  1 +
 generic/tclInt.h     |  5 +++++
 tests/coroutine.test | 34 ++++++++++++++++++++++++++++++++++
 4 files changed, 63 insertions(+), 1 deletion(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 86d7960..69194f8 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4866,6 +4866,7 @@ NRCommand(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *listPtr;
 
     iPtr->numLevels--;
 
@@ -4874,7 +4875,10 @@ NRCommand(
       */
 
     if (data[1] && (data[1] != INT2PTR(1))) {
-        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+	listPtr = (Tcl_Obj *)data[1];
+	data[1] = NULL;
+
+	TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL);
     }
 
     /* OPT ??
@@ -9449,6 +9453,7 @@ TclNRYieldToObjCmd(
 
     iPtr->execEnvPtr = corPtr->callerEEPtr;
     TclSetTailcall(interp, listPtr);
+    corPtr->yieldPtr = listPtr;
     iPtr->execEnvPtr = corPtr->eePtr;
 
     return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
@@ -9646,6 +9651,22 @@ TclNRCoroutineActivateCallback(
          */
 
         if (corPtr->stackLevel != stackLevel) {
+	    NRE_callback *runPtr;
+
+	    iPtr->execEnvPtr = corPtr->callerEEPtr;
+	    if (corPtr->yieldPtr) {
+		for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+		    if (runPtr->data[1] == corPtr->yieldPtr) {
+			runPtr->data[1] = NULL;
+			Tcl_DecrRefCount(corPtr->yieldPtr);
+			corPtr->yieldPtr = NULL;
+			break;
+		    }
+		}
+	    }
+	    iPtr->execEnvPtr = corPtr->eePtr;
+
+
             Tcl_SetObjResult(interp, Tcl_NewStringObj(
                     "cannot yield: C stack busy", -1));
             Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
@@ -9661,6 +9682,7 @@ TclNRCoroutineActivateCallback(
             Tcl_Panic("Yield received an option which is not implemented");
         }
 
+	corPtr->yieldPtr = NULL;
         corPtr->stackLevel = NULL;
 
         numLevels = iPtr->numLevels;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f9c2954..7e51c0d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2506,6 +2506,7 @@ TEBCresume(
 	Tcl_IncrRefCount(valuePtr);
 	iPtr->execEnvPtr = corPtr->callerEEPtr;
 	TclSetTailcall(interp, valuePtr);
+	corPtr->yieldPtr = valuePtr;
 	iPtr->execEnvPtr = corPtr->eePtr;
 	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ad9a5c1..05167b7 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1496,6 +1496,11 @@ typedef struct CoroutineData {
     int nargs;                  /* Number of args required for resuming this
 				 * coroutine; -2 means "0 or 1" (default), -1
 				 * means "any" */
+    Tcl_Obj *yieldPtr;		/* The command to yield to.  Stored here in
+				 * order to reset splice point in
+				 * TclNRCoroutineActivateCallback if the
+				 * coroutine is busy.
+				*/
 } CoroutineData;
 
 typedef struct ExecEnv {
diff --git a/tests/coroutine.test b/tests/coroutine.test
index b129c03..e155d09 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -755,6 +755,40 @@ test coroutine-7.12 {coro floor above street level #3008307} -body {
     rename boom {}; rename cc {}; rename c {}
 } -result {}
 
+
+test coroutine-7.13 {
+issue f9800d52bd61f240
+
+vwait is not NRE-enabled, and yieldto cannot find the right splicing spot
+} -body {
+	coroutine c0 apply [list {} {
+		variable done
+		yield
+		yieldto c1
+		after 0 c2 
+		vwait [namespace current]::done
+	} [namespace current]]
+
+	coroutine c1 apply [list {} {
+		yield
+		tailcall c0
+	} [namespace current]]
+
+	coroutine c2 apply [list {} {
+		variable done
+		yield
+		after 0 [list [info coroutine]]
+		yieldto try {yieldto c1}
+		after 0 [list [info coroutine]]
+		yieldto try {yieldto c1}
+		set done 1
+	} [namespace current]]
+
+	after 0 [list [namespace which c0]]
+	vwait [namespace current]::done
+	return $done
+} -result 1 
+
 test coroutine-8.0.0 {coro inject executed} -body {
     coroutine demo apply {{} { foreach i {1 2} yield }}
     demo
-- 
cgit v0.12