From 59d8c6ba4b9cc7f77258e0cdae09b6d786f19fc4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 15 Jul 2013 20:16:11 +0000
Subject: Build CompileBasicNArgCommand on top of TclCompileInvocation.

---
 generic/tclBasic.c    | 22 ++++++++++++++++++----
 generic/tclCompile.c  |  6 +++---
 generic/tclCompile.h  |  3 +++
 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;
 }
 
-- 
cgit v0.12