summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/coroutine.n106
-rw-r--r--generic/tclBasic.c285
-rw-r--r--tests/coroutine.test153
3 files changed, 518 insertions, 26 deletions
diff --git a/doc/coroutine.n b/doc/coroutine.n
index 52775ef..3c1cf6c 100644
--- a/doc/coroutine.n
+++ b/doc/coroutine.n
@@ -14,10 +14,13 @@ coroutine, yield, yieldto \- Create and produce values from coroutines
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?
-.VS TIP396
\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
\fIname\fR ?\fIvalue...\fR?
-.VE TIP396
+.sp
+.VS "8.7, TIP383"
+\fBcoroinject \fIcoroName command\fR ?\fIarg...\fR?
+\fBcoroprobe \fIcoroName command\fR ?\fIarg...\fR?
+.VE "8.7, TIP383"
.fi
.BE
.SH DESCRIPTION
@@ -39,7 +42,6 @@ the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.
.PP
-.VS TIP396
The coroutine may also suspend its execution by use of the \fByieldto\fR
command, which instead of returning, cedes execution to some command called
\fIcommand\fR (resolved in the context of the coroutine) and to which \fIany
@@ -58,11 +60,10 @@ with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR
command, like this:
.PP
.CS
-proc yieldm {value} {
- \fByieldto\fR return -level 0 $value
+proc yieldMultiple {value} {
+ tailcall \fByieldto\fR string cat $value
}
.CE
-.VE TIP396
.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
@@ -75,6 +76,51 @@ At the point when \fIcommand\fR is called, the current namespace will be the
global namespace and there will be no stack frames above it (in the sense of
\fBupvar\fR and \fBuplevel\fR). However, which command to call will be
determined in the namespace that the \fBcoroutine\fR command was called from.
+.PP
+.VS "8.7, TIP383"
+A suspended coroutine (i.e., one that has \fByield\fRed or \fByieldto\fR-d)
+may have its state inspected (or modified) at that point by using
+\fBcoroprobe\fR to run a command at the point where the coroutine is at. The
+command takes the name of the coroutine to run the command in, \fIcoroName\fR,
+and the name of a command (any any arguments it requires) to immediately run
+at that point. The result of that command is the result of the \fBcoroprobe\fR
+command, and the gross state of the coroutine remains the same afterwards
+(i.e., the coroutine is still expecting the results of a \fByield\fR or
+\fByieldto\fR as before) though variables may have been changed.
+.PP
+Similarly, the \fBcoroinject\fR command may be used to place a command to be
+run inside a suspended coroutine (when it is resumed) to process arguments,
+with quite a bit of similarity to \fBcoroprobe\fR. However, with
+\fBcoroinject\fR there are several key differences:
+.VE "8.7, TIP383"
+.IP \(bu
+.VS "8.7, TIP383"
+The coroutine is not immediately resumed after the injection has been done. A
+consequence of this is that multiple injections may be done before the
+coroutine is resumed. There injected commands are performed in \fIreverse
+order of definition\fR (that is, they are internally stored on a stack).
+.VE "8.7, TIP383"
+.IP \(bu
+.VS "8.7, TIP383"
+An additional two arguments are appended to the list of arguments to be run
+(that is, the \fIcommand\fR and its \fIargs\fR are extended by two elements).
+The first is the name of the command that suspended the coroutine (\fByield\fR
+or \fByieldto\fR), and the second is the argument (or list of arguments, in
+the case of \fByieldto\fR) that is the current resumption value.
+.VE "8.7, TIP383"
+.IP \(bu
+.VS "8.7, TIP383"
+The result of the injected command is used as the result of the \fByield\fR or
+\fByieldto\fR that caused the coroutine to become suspended. Where there are
+multiple injected commands, the result of one becomes the resumption value
+processed by the next.
+.PP
+The injection is a one-off. It is not retained once it has been executed. It
+may \fByield\fR or \fByieldto\fR as part of its execution.
+.PP
+Note that running coroutines may be neither probed nor injected; the
+operations may only be applied to
+.VE "8.7, TIP383"
.SH EXAMPLES
.PP
This example shows a coroutine that will produce an infinite sequence of
@@ -138,7 +184,6 @@ for {set i 1} {$i <= 20} {incr i} {
}
.CE
.PP
-.VS TIP396
This example shows how a value can be passed around a group of three
coroutines that yield to each other:
.PP
@@ -150,14 +195,57 @@ proc juggler {name target {value ""}} {
while {$value ne ""} {
puts "$name : $value"
set value [string range $value 0 end-1]
- lassign [\fByieldto\fR $target $value] value
+ lassign [\fByieldto\fR \fI$target\fR $value] value
}
}
\fBcoroutine\fR j1 juggler Larry [
\fBcoroutine\fR j2 juggler Curly [
\fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
.CE
-.VE TIP396
+.PP
+.VS "8.7, TIP383"
+This example shows a simple coroutine that collects non-empty values and
+returns a list of them when not given an argument. It also shows how we can
+look inside the coroutine to find out what it is doing, and how we can modify
+the input on a one-off basis.
+.PP
+.CS
+proc collectorImpl {} {
+ set me [info coroutine]
+ set accumulator {}
+ for {set val [\fByield\fR $me]} {$val ne ""} {set val [\fByield\fR]} {
+ lappend accumulator $val
+ }
+ return $accumulator
+}
+
+\fBcoroutine\fR collect collectorImpl
+\fIcollect\fR 123
+\fIcollect\fR "abc def"
+\fIcollect\fR 456
+
+puts [\fBcoroprobe \fIcollect\fR set accumulator]
+# ==> 123 {abc def} 456
+
+\fIcollect\fR "pqr"
+
+\fBcoroinject \fIcollect\fR apply {{type value} {
+ puts "Received '$value' at a $type in [info coroutine]"
+ return [string toupper $value]
+}}
+
+\fIcollect\fR rst
+# ==> Received 'rst' at a yield in ::collect
+\fIcollect\fR xyz
+
+puts [\fIcollect\fR]
+# ==> 123 {abc def} 456 pqr RST xyz
+.CE
+.PP
+This example shows a simple coroutine that collects non-empty values and
+returns a list of them when not given an argument. It also shows how we can
+look inside the coroutine to find out what it is doing.
+.VE "8.7, TIP383"
.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ae7d7ff..d7eaf80 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -171,9 +171,13 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_NRPostProc EvalObjvCore;
static Tcl_NRPostProc Dispatch;
-static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_ObjCmdProc NRInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;
+static Tcl_ObjCmdProc TclNRCoroInjectObjCmd;
+static Tcl_ObjCmdProc TclNRCoroProbeObjCmd;
+static Tcl_NRPostProc InjectHandler;
+static Tcl_NRPostProc InjectHandlerPostCall;
MODULE_SCOPE const TclStubs tclStubs;
@@ -243,6 +247,8 @@ static const CmdInfo builtInCmds[] = {
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
{"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
+ {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE},
+ {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE},
{"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE},
{"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE},
{"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE},
@@ -977,7 +983,7 @@ Tcl_CreateInterp(void)
/* Coroutine monkeybusiness */
Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
- NRCoroInjectObjCmd, NULL, NULL);
+ NRInjectObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
CoroTypeObjCmd, NULL, NULL);
@@ -9279,27 +9285,47 @@ CoroTypeObjCmd(
/*
*----------------------------------------------------------------------
*
- * NRCoroInjectObjCmd --
+ * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd --
*
- * Implementation of [::tcl::unsupported::inject] command.
+ * Implementation of [coroinject] and [coroprobe] commands.
*
*----------------------------------------------------------------------
*/
+static inline CoroutineData *
+GetCoroutineFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ const char *errMsg)
+{
+ /*
+ * How to get a coroutine from its handle.
+ */
+
+ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
+
+ if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+ TclGetString(objPtr), NULL);
+ return NULL;
+ }
+ return cmdPtr->objClientData;
+}
+
static int
-NRCoroInjectObjCmd(
+TclNRCoroInjectObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
- Command *cmdPtr;
CoroutineData *corPtr;
ExecEnv *savedEEPtr = iPtr->execEnvPtr;
/*
* Usage more or less like tailcall:
- * inject coroName cmd ?arg1 arg2 ...?
+ * coroinject coroName cmd ?arg1 arg2 ...?
*/
if (objc < 3) {
@@ -9307,16 +9333,249 @@ NRCoroInjectObjCmd(
return TCL_ERROR;
}
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
- if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
+ corPtr = GetCoroutineFromObj(interp, objv[1],
+ "can only inject a command into a coroutine");
+ if (!corPtr) {
+ return TCL_ERROR;
+ }
+ if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can only inject a command into a coroutine", -1));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
- TclGetString(objv[1]), NULL);
+ "can only inject a command into a suspended coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
return TCL_ERROR;
}
- corPtr = cmdPtr->objClientData;
+ /*
+ * Add the callback to the coro's execEnv, so that it is the first thing
+ * to happen when the coro is resumed.
+ */
+
+ iPtr->execEnvPtr = corPtr->eePtr;
+ TclNRAddCallback(interp, InjectHandler, corPtr,
+ Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL);
+ iPtr->execEnvPtr = savedEEPtr;
+
+ return TCL_OK;
+}
+
+static int
+TclNRCoroProbeObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CoroutineData *corPtr;
+ ExecEnv *savedEEPtr = iPtr->execEnvPtr;
+ int numLevels, unused;
+ int *stackLevel = &unused;
+
+ /*
+ * Usage more or less like tailcall:
+ * coroprobe coroName cmd ?arg1 arg2 ...?
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
+ return TCL_ERROR;
+ }
+
+ corPtr = GetCoroutineFromObj(interp, objv[1],
+ "can only inject a probe command into a coroutine");
+ if (!corPtr) {
+ return TCL_ERROR;
+ }
+ if (!COR_IS_SUSPENDED(corPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a probe command into a suspended coroutine",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add the callback to the coro's execEnv, so that it is the first thing
+ * to happen when the coro is resumed.
+ */
+
+ iPtr->execEnvPtr = corPtr->eePtr;
+ TclNRAddCallback(interp, InjectHandler, corPtr,
+ Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr);
+ iPtr->execEnvPtr = savedEEPtr;
+
+ /*
+ * Now we immediately transfer control to the coroutine to run our probe.
+ * TRICKY STUFF copied from the [yield] implementation.
+ *
+ * Push the callback to restore the caller's context on yield back.
+ */
+
+ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
+ NULL, NULL, NULL);
+
+ /*
+ * Record the stackLevel at which the resume is happening, then swap
+ * the interp's environment to make it suitable to run this coroutine.
+ */
+
+ corPtr->stackLevel = stackLevel;
+ numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = iPtr->numLevels;
+
+ /*
+ * Do the actual stack swap.
+ */
+
+ SAVE_CONTEXT(corPtr->caller);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ RESTORE_CONTEXT(corPtr->running);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ iPtr->numLevels += numLevels;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InjectHandler, InjectHandlerPostProc --
+ *
+ * Part of the implementation of [coroinject] and [coroprobe]. These are
+ * run inside the context of the coroutine being injected/probed into.
+ *
+ * InjectHandler runs a script (possibly adding arguments) in the context
+ * of the coroutine. The script is specified as a one-shot list (with
+ * reference count equal to 1) in data[1]. This function also arranges
+ * for InjectHandlerPostProc to be the part that runs after the script
+ * completes.
+ *
+ * InjectHandlerPostProc cleans up after InjectHandler (deleting the
+ * list) and, for the [coroprobe] command *only*, yields back to the
+ * caller context (i.e., where [coroprobe] was run).
+ *s
+ *----------------------------------------------------------------------
+ */
+
+static int
+InjectHandler(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ Tcl_Obj *listPtr = data[1];
+ int nargs = PTR2INT(data[2]);
+ ClientData isProbe = data[3];
+ int objc;
+ Tcl_Obj **objv;
+
+ if (!isProbe) {
+ /*
+ * If this is [coroinject], add the extra arguments now.
+ */
+
+ if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj("yield", -1));
+ } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj("yieldto", -1));
+ } else {
+ /*
+ * I don't think this is reachable...
+ */
+
+ Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs));
+ }
+ Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
+ }
+
+ /*
+ * Call the user's script; we're in the right place.
+ */
+
+ Tcl_IncrRefCount(listPtr);
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr,
+ INT2PTR(nargs), isProbe);
+ TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ return TclNREvalObjv(interp, objc, objv, 0, NULL);
+}
+
+static int
+InjectHandlerPostCall(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ Tcl_Obj *listPtr = data[1];
+ int nargs = PTR2INT(data[2]);
+ ClientData isProbe = data[3];
+ int numLevels;
+
+ /*
+ * Delete the command words for what we just executed.
+ */
+
+ Tcl_DecrRefCount(listPtr);
+
+ /*
+ * If we were doing a probe, splice ourselves back out of the stack
+ * cleanly here. General injection should instead just look after itself.
+ *
+ * Code from guts of [yield] implementation.
+ */
+
+ if (isProbe) {
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (injected coroutine probe command)");
+ }
+ corPtr->nargs = nargs;
+ corPtr->stackLevel = NULL;
+ numLevels = iPtr->numLevels;
+ iPtr->numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NRInjectObjCmd --
+ *
+ * Implementation of [::tcl::unsupported::inject] command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NRInjectObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CoroutineData *corPtr;
+ ExecEnv *savedEEPtr = iPtr->execEnvPtr;
+
+ /*
+ * Usage more or less like tailcall:
+ * inject coroName cmd ?arg1 arg2 ...?
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
+ return TCL_ERROR;
+ }
+
+ corPtr = GetCoroutineFromObj(interp, objv[1],
+ "can only inject a command into a coroutine");
+ if (!corPtr) {
+ return TCL_ERROR;
+ }
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can only inject a command into a suspended coroutine", -1));
diff --git a/tests/coroutine.test b/tests/coroutine.test
index ffb9eb9..86a5481 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -793,7 +793,152 @@ test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body {
set result
} -result {inject-executed}
-test coroutine-9.1 {coro type} {
+test coroutine-9.1 {coroprobe with yield} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ list [coroprobe demo set i] [demo] [coroprobe demo set i] [demo]
+} -cleanup {
+ catch {rename demo {}}
+} -result {1 {} 2 {}}
+test coroutine-9.2 {coroprobe with yieldto} -body {
+ coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
+ list [coroprobe demo set i] [demo a b] [coroprobe demo set i] [demo c d]
+} -cleanup {
+ catch {rename demo {}}
+} -result {1 {} 2 {{a b} {c d}}}
+test coroutine-9.3 {coroprobe errors} -setup {
+ catch {rename demo {}}
+} -body {
+ coroprobe demo set i
+} -returnCodes error -result {can only inject a probe command into a coroutine}
+test coroutine-9.4 {coroprobe errors} -body {
+ proc demo {} { foreach i {1 2} yield }
+ coroprobe demo set i
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {can only inject a probe command into a coroutine}
+test coroutine-9.5 {coroprobe errors} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroprobe
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
+test coroutine-9.6 {coroprobe errors} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroprobe demo
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
+test coroutine-9.7 {coroprobe errors in probe command} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroprobe demo set
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {wrong # args: should be "set varName ?newValue?"}
+test coroutine-9.8 {coroprobe errors in probe command} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ list [catch {coroprobe demo set}] [demo] [coroprobe demo set i]
+} -cleanup {
+ catch {rename demo {}}
+} -result {1 {} 2}
+test coroutine-9.9 {coroprobe: advanced features} -setup {
+ set i [interp create]
+} -body {
+ $i eval {
+ coroutine demo apply {{} {
+ set f [info level],[info frame]
+ foreach i {1 2} yield
+ }}
+ coroprobe demo apply {{} {
+ upvar 1 f f
+ list [info coroutine] [info level] [info frame] $f
+ }}
+ }
+} -cleanup {
+ interp delete $i
+} -result {::demo 2 3 1,2}
+
+test coroutine-10.1 {coroinject with yield} -setup {
+ set result {}
+} -body {
+ coroutine demo apply {{} { lmap i {1 2} yield }}
+ coroinject demo apply {{op val} {lappend ::result $op $val}}
+ list $result [demo x] [demo y] $result
+} -cleanup {
+ catch {rename demo {}}
+} -result {{} {} {{yield x} y} {yield x}}
+test coroutine-10.2 {coroinject stacking} -setup {
+ set result {}
+} -body {
+ coroutine demo apply {{} { lmap i {1 2} yield }}
+ coroinject demo apply {{op val} {lappend ::result $op $val A;return $val}}
+ coroinject demo apply {{op val} {lappend ::result $op $val B;return $val}}
+ list $result [demo x] [demo y] $result
+} -cleanup {
+ catch {rename demo {}}
+} -result {{} {} {x y} {yield x B yield x A}}
+test coroutine-10.3 {coroinject with yieldto} -setup {
+ set result {}
+} -body {
+ coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
+ coroinject demo apply {{op val} {lappend ::result $op $val;return $val}}
+ list $result [demo x mp] [demo y le] $result
+} -cleanup {
+ catch {rename demo {}}
+} -result {{} {} {{x mp} {y le}} {yieldto {x mp}}}
+test coroutine-10.4 {coroinject errors} -setup {
+ catch {rename demo {}}
+} -body {
+ coroinject demo set i
+} -returnCodes error -result {can only inject a command into a coroutine}
+test coroutine-10.5 {coroinject errors} -body {
+ proc demo {} { foreach i {1 2} yield }
+ coroinject demo set i
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {can only inject a command into a coroutine}
+test coroutine-10.6 {coroinject errors} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroinject
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
+test coroutine-10.7 {coroinject errors} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroinject demo
+} -returnCodes error -cleanup {
+ catch {rename demo {}}
+} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
+test coroutine-10.8 {coroinject errors in injected command} -body {
+ coroutine demo apply {{} { foreach i {1 2} yield }}
+ coroinject demo apply {args {error "ERR: $args"}}
+ list [catch demo msg] $msg [catch demo msg] $msg
+} -cleanup {
+ catch {rename demo {}}
+} -result {1 {ERR: yield {}} 1 {invalid command name "demo"}}
+test coroutine-10.9 {coroinject: advanced features} -setup {
+ set i [interp create]
+} -body {
+ $i eval {
+ coroutine demo apply {{} {
+ set l [info level]
+ set f [info frame]
+ lmap i {1 2} yield
+ }}
+ coroinject demo apply {{arg op val} {
+ global result
+ upvar 1 f f l l
+ lappend result [info coroutine] $arg $op $val
+ lappend result [info level] $l [info frame] $f
+ lappend result [yield $arg]
+ return [string toupper $val]
+ }} grill
+ list [demo ABC] [demo pqr] [demo def] $result
+ }
+} -cleanup {
+ interp delete $i
+} -result {grill {} {ABC def} {::demo grill yield ABC 2 1 3 2 pqr}}
+
+test coroutine-11.1 {coro type} {
coroutine demo eval {
yield
yield "PHASE 1"
@@ -803,19 +948,19 @@ test coroutine-9.1 {coro type} {
list [demo] [::tcl::unsupported::corotype demo] \
[demo] [::tcl::unsupported::corotype demo] [demo]
} {{PHASE 1} yield {PHASE 2} yieldto active}
-test coroutine-9.2 {coro type} -setup {
+test coroutine-11.2 {coro type} -setup {
catch {rename nosuchcommand ""}
} -returnCodes error -body {
::tcl::unsupported::corotype nosuchcommand
} -result {can only get coroutine type of a coroutine}
-test coroutine-9.3 {coro type} -returnCodes error -body {
+test coroutine-11.3 {coro type} -returnCodes error -body {
proc notacoroutine {} {}
::tcl::unsupported::corotype notacoroutine
} -returnCodes error -cleanup {
rename notacoroutine {}
} -result {can only get coroutine type of a coroutine}
-test coroutine-10.1 {coroutine general introspection} -setup {
+test coroutine-12.1 {coroutine general introspection} -setup {
set i [interp create]
} -body {
$i eval {