Skip to content

Commit a4780b8

Browse files
dkfellowsdkfellows
committed
Make [yieldto] work with {*}; turns out no new opcodes were needed, just a test for a previously-impossible case
1 parent 5d4f754 commit a4780b8

File tree

6 files changed

+99
-19
lines changed

6 files changed

+99
-19
lines changed

‎generic/tclBasic.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -370,7 +370,7 @@ static const CmdInfo builtInCmds[] = {
370370
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
371371
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
372372
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
373-
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
373+
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
374374

375375
/*
376376
* Commands in the OS-interface. Note that many of these are unsafe.

‎generic/tclCompCmdsGR.c

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -27,9 +27,6 @@ static void CompileReturnInternal(CompileEnv *envPtr,
2727
Tcl_Obj *returnOpts);
2828
static Tcl_LVTIndex IndexTailVarIfKnown(Tcl_Interp *interp,
2929
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
30-
31-
// Maximum number of items to concatenate in one go.
32-
#define MAX_LIST_CONCAT 0x7FFFFFFE
3330

3431
/*
3532
*----------------------------------------------------------------------
@@ -928,7 +925,7 @@ TclCompileLappendCmd(
928925
} else {
929926
build++;
930927
}
931-
if (build > MAX_LIST_CONCAT) {
928+
if (build > LIST_CONCAT_THRESHOLD) {
932929
OP4( LIST, build);
933930
if (concat) {
934931
OP( LIST_CONCAT);
@@ -1252,7 +1249,7 @@ TclCompileListCmd(
12521249
} else {
12531250
build++;
12541251
}
1255-
if (build > MAX_LIST_CONCAT) {
1252+
if (build > LIST_CONCAT_THRESHOLD) {
12561253
OP4( LIST, build);
12571254
if (concat) {
12581255
OP( LIST_CONCAT);
@@ -2860,7 +2857,7 @@ TclCompileObjectNextCmd(
28602857
} else {
28612858
build++;
28622859
}
2863-
if (build > MAX_LIST_CONCAT) {
2860+
if (build > LIST_CONCAT_THRESHOLD) {
28642861
OP4( LIST, build);
28652862
if (concat) {
28662863
OP( LIST_CONCAT);
@@ -2942,7 +2939,7 @@ TclCompileObjectNextToCmd(
29422939
} else {
29432940
build++;
29442941
}
2945-
if (build > MAX_LIST_CONCAT) {
2942+
if (build > LIST_CONCAT_THRESHOLD) {
29462943
OP4( LIST, build);
29472944
if (concat) {
29482945
OP( LIST_CONCAT);

‎generic/tclCompCmdsSZ.c

Lines changed: 34 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -109,9 +109,6 @@ const AuxDataType tclJumptableNumericInfoType = {
109109
PrintJumptableNumInfo, /* printProc */
110110
DisassembleJumptableNumInfo /* disassembleProc */
111111
};
112-
113-
// Point at which we issue a LIST_CONCAT anyway
114-
#define LIST_CONCAT_THRESHOLD (1 << 15)
115112

116113
/*
117114
*----------------------------------------------------------------------
@@ -4558,19 +4555,45 @@ TclCompileYieldToCmd(
45584555
{
45594556
DefineLineInformation; /* TIP #280 */
45604557
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
4561-
Tcl_Size i;
4562-
4563-
/* TODO: Consider support for compiling expanded args. */
4564-
if (parsePtr->numWords < 2 || parsePtr->numWords > UINT_MAX) {
4565-
return TCL_ERROR;
4566-
}
4558+
Tcl_Size i, numWords = parsePtr->numWords, build;
4559+
int concat = 0;
45674560

45684561
OP( NS_CURRENT);
4569-
for (i = 1 ; i < parsePtr->numWords ; i++) {
4562+
for (build = i = 1; i < numWords; i++) {
4563+
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
4564+
OP4( LIST, build);
4565+
if (concat) {
4566+
OP( LIST_CONCAT);
4567+
}
4568+
build = 0;
4569+
concat = 1;
4570+
}
45704571
PUSH_TOKEN( tokenPtr, i);
4572+
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
4573+
if (concat) {
4574+
OP( LIST_CONCAT);
4575+
} else {
4576+
concat = 1;
4577+
}
4578+
} else {
4579+
build++;
4580+
}
4581+
if (build > LIST_CONCAT_THRESHOLD) {
4582+
OP4( LIST, build);
4583+
if (concat) {
4584+
OP( LIST_CONCAT);
4585+
}
4586+
build = 0;
4587+
concat = 1;
4588+
}
45714589
tokenPtr = TokenAfter(tokenPtr);
45724590
}
4573-
OP4( LIST, i);
4591+
if (build > 0) {
4592+
OP4( LIST, build);
4593+
if (concat) {
4594+
OP( LIST_CONCAT);
4595+
}
4596+
}
45744597
INVOKE( YIELD_TO_INVOKE);
45754598
return TCL_OK;
45764599
}

‎generic/tclCompile.h

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1382,6 +1382,9 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData,
13821382
*----------------------------------------------------------------
13831383
*/
13841384

1385+
// Point at which we issue a LIST_CONCAT anyway when doing an expansion sequence
1386+
#define LIST_CONCAT_THRESHOLD (1 << 15)
1387+
13851388
/*
13861389
* Simplified form to access AuxData.
13871390
*

‎generic/tclExecute.c

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2563,6 +2563,18 @@ TEBCresume(
25632563
CACHE_STACK_INFO();
25642564
goto gotError;
25652565
}
2566+
Tcl_Size yieldTargetLength;
2567+
if (TclListObjLength(NULL, valuePtr, &yieldTargetLength) != TCL_OK
2568+
|| yieldTargetLength < 2) {
2569+
TRACE_APPEND(("ERROR: no valid target list in yieldto"));
2570+
// Weird case; pretend it's like no arguments given to scripts
2571+
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2572+
"wrong # args: should be \"yieldto command ?arg ...?\""));
2573+
DECACHE_STACK_INFO();
2574+
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
2575+
CACHE_STACK_INFO();
2576+
goto gotError;
2577+
}
25662578

25672579
#ifdef TCL_COMPILE_DEBUG
25682580
if (tclTraceExec >= TCL_TRACE_BYTECODE_EXEC_COMMANDS) {

‎tests/coroutine.test

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -825,6 +825,51 @@ test coroutine-7.14 {
825825
return [list $done0 $done1]
826826
} -result {failure failure}
827827

828+
test coroutine-7.15 {yieldto and expansion} {
829+
coroutine c apply {{{yieldto yieldto}} {
830+
yield
831+
set abc [list 1 2 3]
832+
set abc [list $abc $abc $abc]
833+
$yieldto string cat {*}$abc
834+
return $abc
835+
}}
836+
list [c] [c]
837+
} {{1 2 31 2 31 2 3} {{1 2 3} {1 2 3} {1 2 3}}}
838+
test coroutine-7.16 {yieldto and expansion} {
839+
coroutine c apply {{} {
840+
yield
841+
set abc [list 1 2 3]
842+
set abc [list $abc $abc $abc]
843+
yieldto string cat {*}$abc
844+
return $abc
845+
}}
846+
list [c] [c]
847+
} {{1 2 31 2 31 2 3} {{1 2 3} {1 2 3} {1 2 3}}}
848+
test coroutine-7.17 {yieldto and expansion} {
849+
coroutine c apply {target {
850+
yield
851+
yieldto {*}$target
852+
return done
853+
}} {list 1 2 "3 4"}
854+
list [c] [c]
855+
} {{1 2 {3 4}} done}
856+
test coroutine-7.18 {yieldto and expansion} -body {
857+
coroutine c apply {{target {yieldto yieldto}} {
858+
yield
859+
$yieldto {*}$target
860+
return done
861+
}} {}
862+
list [c] [c]
863+
} -returnCodes error -result {wrong # args: should be "yieldto command ?arg ...?"}
864+
test coroutine-7.19 {yieldto and expansion} -body {
865+
coroutine c apply {target {
866+
yield
867+
yieldto {*}$target
868+
return done
869+
}} {}
870+
list [c] [c]
871+
} -returnCodes error -result {wrong # args: should be "yieldto command ?arg ...?"}
872+
828873
test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body {
829874
interp create child
830875
child eval {

0 commit comments

Comments
 (0)