Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-383 Excluding Merge-Ins
This is equivalent to a diff from ec114b14ff to de44589e23
2019-05-25
| ||
08:06 | TIP 383: [coroinject] and [coroprobe] check-in: 7bcb41aa5e user: dkf tags: core-8-branch | |
08:01 | Add to error info when passing an error out of [coroprobe] Closed-Leaf check-in: de44589e23 user: dkf tags: tip-383 | |
2019-05-01
| ||
10:44 | merge bug-de232b49f2 check-in: f51188e305 user: pooryorick tags: core-8-branch | |
2019-04-30
| ||
07:44 | Starting to implement a temporary directory creator. check-in: ca92b413f2 user: dkf tags: tip-431 | |
2019-04-28
| ||
16:17 | Advanced feature tests check-in: 4d84822cda user: dkf tags: tip-383 | |
2019-04-27
| ||
17:56 | Implement 383 as two commands for two scenarios: injection and probing check-in: 8aa55737df user: dkf tags: tip-383 | |
2019-04-24
| ||
19:29 | Track memory lifetimes in the zip mount/unmount. check-in: 8811378a89 user: dgp tags: dgp-wip | |
14:29 | Plug memleak in [lpop] due to mishandling the unconventional recounting practices of TclLsetFlat(). check-in: ec114b14ff user: dgp tags: core-8-branch | |
04:52 | merge bug-67a5eabbd3d1 check-in: 9bcec7cd88 user: pooryorick tags: core-8-branch | |
Changes to doc/coroutine.n.
︙ | ︙ | |||
10 11 12 13 14 15 16 | '\" Note: do not modify the .SH NAME line immediately below! .SH NAME coroutine, yield, yieldto \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? | < > | > > > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | '\" Note: do not modify the .SH NAME line immediately below! .SH NAME coroutine, yield, yieldto \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? \fByieldto\fR \fIcommand\fR ?\fIarg...\fR? \fIname\fR ?\fIvalue...\fR? .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 .PP The \fBcoroutine\fR command creates a new coroutine context (with associated command) named \fIname\fR and executes that context by calling \fIcommand\fR, passing in the other remaining arguments without further interpretation. Once |
︙ | ︙ | |||
35 36 37 38 39 40 41 | of the context can then be resumed by calling the context command, optionally passing in the \fIsingle\fR value to use as the result of the \fByield\fR call that caused 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 | < | | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | of the context can then be resumed by calling the context command, optionally passing in the \fIsingle\fR value to use as the result of the \fByield\fR call that caused 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 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 number\fR of arguments may be passed. Since every coroutine has a context command, \fByieldto\fR can be used to transfer control directly from one coroutine to another (this is only advisable if the two coroutines are expecting this to happen) but \fIany\fR command may be the target. If a coroutine is suspended by this mechanism, the coroutine processing can be resumed by calling the context command optionally passing in an arbitrary number of arguments. The return value of the \fByieldto\fR call will be the list of arguments passed to the context command; it is up to the caller to decide what to do with those values. .PP The recommended way of writing a version of \fByield\fR that allows resumption with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR command, like this: .PP .CS proc yieldMultiple {value} { tailcall \fByieldto\fR string cat $value } .CE .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 \fBinfo coroutine\fR. If there are deletion traces on variables in the coroutine's implementation, they will fire at the point when the coroutine is explicitly deleted (or, naturally, if the command returns conventionally). .PP 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 even values, and a loop that consumes the first ten of them. .PP .CS proc allNumbers {} { |
︙ | ︙ | |||
134 135 136 137 138 139 140 | } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .PP | < | > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .PP This example shows how a value can be passed around a group of three coroutines that yield to each other: .PP .CS proc juggler {name target {value ""}} { if {$value eq ""} { set value [\fByield\fR [info coroutine]] } while {$value ne ""} { puts "$name : $value" set value [string range $value 0 end-1] 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 .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 that \fIcommand\fR resolution happens before the coroutine stack is created. .PP .CS proc report {where level} { |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
167 168 169 170 171 172 173 | static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; | | > > > > > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc TclNRCoroInjectObjCmd; static Tcl_ObjCmdProc TclNRCoroProbeObjCmd; static Tcl_NRPostProc InjectHandler; static Tcl_NRPostProc InjectHandlerPostCall; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ |
︙ | ︙ | |||
238 239 240 241 242 243 244 245 246 247 248 249 250 251 | {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 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}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, | > > | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"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}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, |
︙ | ︙ | |||
970 971 972 973 974 975 976 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, | | | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); } |
︙ | ︙ | |||
9182 9183 9184 9185 9186 9187 9188 | TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } /* *---------------------------------------------------------------------- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < | < < | < | < < | 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 9280 9281 9282 9283 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 | TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } /* *---------------------------------------------------------------------- * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * * 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 TclNRCoroInjectObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; /* * Usage more or less like tailcall: * coroinject 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)); 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), 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)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } |
︙ | ︙ |
Changes to tests/coroutine.test.
︙ | ︙ | |||
788 789 790 791 792 793 794 795 796 797 798 799 800 801 | } slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} # cleanup unset lambda ::tcltest::cleanupTests return | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 | } slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} 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}} # cleanup unset lambda ::tcltest::cleanupTests return |
︙ | ︙ |