summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-10-29 11:02:45 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-10-29 11:02:45 (GMT)
commit78ed75a33905e55e8eabc5e41651556fbbc60fbc (patch)
treefa1296b8f4044407e3dc223984e7c7f6aac15875
parenta0f1506da36a7571a129af6904493cd83fe18051 (diff)
downloadtcl-78ed75a33905e55e8eabc5e41651556fbbc60fbc.zip
tcl-78ed75a33905e55e8eabc5e41651556fbbc60fbc.tar.gz
tcl-78ed75a33905e55e8eabc5e41651556fbbc60fbc.tar.bz2
Compilation of [info commands] in the case of a fully-qualified literal name.
-rw-r--r--generic/tclCmdIL.c2
-rw-r--r--generic/tclCompCmds.c58
-rw-r--r--generic/tclInt.h3
3 files changed, 62 insertions, 1 deletions
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);