From 78ed75a33905e55e8eabc5e41651556fbbc60fbc Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 29 Oct 2012 11:02:45 +0000
Subject: Compilation of [info commands] in the case of a fully-qualified
 literal name.

---
 generic/tclCmdIL.c    |  2 +-
 generic/tclCompCmds.c | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclInt.h      |  3 +++
 3 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 14e9f0e..7be017d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -164,7 +164,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
     {"args",		   InfoArgsCmd,		    NULL, NULL, NULL, 0},
     {"body",		   InfoBodyCmd,		    NULL, NULL, NULL, 0},
     {"cmdcount",	   InfoCmdCountCmd,	    NULL, NULL, NULL, 0},
-    {"commands",	   InfoCommandsCmd,	    NULL, NULL, NULL, 0},
+    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
     {"complete",	   InfoCompleteCmd,	    NULL, NULL, NULL, 0},
     {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
     {"default",		   InfoDefaultCmd,	    NULL, NULL, NULL, 0},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d7ee85e..79b2709 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -3038,6 +3038,64 @@ TclCompileIncrCmd(
  */
 
 int
+TclCompileInfoCommandsCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    Tcl_Obj *objPtr;
+    char *bytes;
+
+    /*
+     * We require one compile-time known argument for the case we can compile.
+     */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    objPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(objPtr);
+    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	goto notCompilable;
+    }
+    bytes = Tcl_GetString(objPtr);
+
+    /*
+     * We require that the argument start with "::" and not have any of "*\[?"
+     * in it. (Theoretically, we should look in only the final component, but
+     * the difference is so slight given current naming practices.)
+     */
+
+    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
+	goto notCompilable;
+    }
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Confirmed as a literal that will not frighten the horses. Compile. Note
+     * that the result needs to be list-ified.
+     */
+
+    CompileWord(envPtr, tokenPtr,		interp, 1);
+    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
+    TclEmitOpcode(	INST_DUP,		envPtr);
+    TclEmitOpcode(	INST_STR_LEN,		envPtr);
+    TclEmitInstInt1(	INST_JUMP_FALSE1, 7,	envPtr);
+    TclEmitInstInt4(	INST_LIST, 1,		envPtr);
+    return TCL_OK;
+
+  notCompilable:
+    Tcl_DecrRefCount(objPtr);
+    return TCL_ERROR;
+}
+
+int
 TclCompileInfoCoroutineCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 448a7cd..a26ade3 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3549,6 +3549,9 @@ MODULE_SCOPE int	TclCompileGlobalCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileIfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoCommandsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileInfoCoroutineCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12