diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 22 | ||||
| -rw-r--r-- | generic/tclCompile.c | 6 | ||||
| -rw-r--r-- | generic/tclCompile.h | 3 | ||||
| -rw-r--r-- | generic/tclEnsemble.c | 10 |
4 files changed, 34 insertions, 7 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b2a505a..963b53a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5633,6 +5633,24 @@ TclArgumentBCEnter( CFWordBC *lastPtr = NULL; /* + * ePtr->nline is the number of words originally parsed. + * + * objc is the number of elements getting invoked. + * + * If they are not the same, we arrived here by compiling an + * ensemble dispatch. Ensemble subcommands that lead to script + * evaluation are not supposed to get compiled, because a command + * such as [info level] in the script can expose some of the dispatch + * shenanigans. This means that we don't have to tend to the + * housekeeping, and can escape now. + */ + + if (ePtr->nline != objc) { + return; + } + + /* + * Having disposed of the ensemble cases, we can state... * A few truths ... * (1) ePtr->nline == objc * (2) (ePtr->line[word] < 0) => !literal, for all words @@ -5642,10 +5660,6 @@ TclArgumentBCEnter( * have to save them at compile time. */ - if (ePtr->nline != objc) { - Tcl_Panic ("TIP 280 data structure inconsistency"); - } - for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { int isnew; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 5f4acff..a2c7131 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1777,8 +1777,8 @@ CompileCmdLiteral( TclEmitPush(cmdLitIdx, envPtr); } -static void -CompileInvocation( +void +TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, @@ -2095,7 +2095,7 @@ CompileCommandTokens( CompileExpanded(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } else { - CompileInvocation(interp, parsePtr->tokenPtr, + TclCompileInvocation(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0bcd84e..b94bd93 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1003,6 +1003,9 @@ MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); +MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, + Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, + CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 680ab45d..9b6ca92 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3229,6 +3229,15 @@ CompileBasicNArgCommand( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { +#if 1 + Tcl_Obj *objPtr = Tcl_NewObj(); + + Tcl_IncrRefCount(objPtr); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); + TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, + parsePtr->numWords, envPtr); + Tcl_DecrRefCount(objPtr); +#else Tcl_Token *tokenPtr; Tcl_Obj *objPtr; char *bytes; @@ -3272,6 +3281,7 @@ CompileBasicNArgCommand( } else { TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr); } +#endif return TCL_OK; } |