diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | doc/interp.n | 14 | ||||
| -rw-r--r-- | generic/tclBasic.c | 67 | ||||
| -rw-r--r-- | generic/tclInt.h | 20 | ||||
| -rw-r--r-- | generic/tclInterp.c | 87 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 57 | ||||
| -rw-r--r-- | generic/tclTrace.c | 4 | ||||
| -rw-r--r-- | tests/interp.test | 15 |
8 files changed, 193 insertions, 81 deletions
@@ -1,5 +1,15 @@ 2004-08-02 Don Porter <dgp@users.sourceforge.net> + TIP#207 IMPLEMENTATION + + * doc/interp.n: Added support for a -namespace option to the + * generic/tclBasic.c: [interp invokehidden] command. Also added an + * generic/tclInt.h: internal routine TclObjInvokeNamespace() and + * generic/tclInterp.c: corrected the flag names TCL_FIND_ONLY_NS and + * generic/tclNamesp.c: TCL_CREATE_NS_IF_UNKNOWN that are passed to the + * generic/tclTrace.c: internal routine TclGetNamespaceForQualName(). + * tests/interp.test: [Patch 981841] + * generic/tclLiteral.c (TclCleanupLiteralTable): Corrected * tests/compile.test (compile-12.4): flawed deletion of literal internal reps that could lead to accessing of freed memory. diff --git a/doc/interp.n b/doc/interp.n index 0f5aba4..1174877 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: interp.n,v 1.13 2004/05/30 12:18:25 dkf Exp $ +'\" RCS: @(#) $Id: interp.n,v 1.14 2004/08/02 20:55:36 dgp Exp $ '\" .so man.macros .TH interp n 7.6 Tcl "Tcl Built-In Commands" @@ -200,14 +200,18 @@ Hidden commands are explained in more detail in HIDDEN COMMANDS, below. Returns a list of the names of all hidden commands in the interpreter identified by \fIpath\fR. .TP -\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fB-global\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR? +\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fB-namespace\fR \fInamespace\fR? ?\fB-global\fR? ?\fB\-\|\-\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR? Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied in the interpreter denoted by \fIpath\fR. No substitutions or evaluation are applied to the arguments. +If the \fB-namespace\fR flag is present, the hidden command is invoked in +the specified namespace in the target interpreter. If the \fB-global\fR flag is present, the hidden command is invoked at the global level in the target interpreter; otherwise it is invoked at the current call frame and can access local variables in that and outer call frames. +If both the \fB-namespace\fR and \fB-global\fR flags are present, the +\fB-namespace\fR flag is ignored. Hidden commands are explained in more detail in HIDDEN COMMANDS, below. .TP \fBinterp\fR \fBlimit\fR \fIpath\fR \fIlimitType\fR ?\fIoption\fR? ?\fIvalue\fR \fI...\fR? @@ -353,13 +357,17 @@ For more details on hidden commands, see HIDDEN COMMANDS, below. \fIslave \fBhidden\fR Returns a list of the names of all hidden commands in \fIslave\fR. .TP -\fIslave \fBinvokehidden\fR ?\fB-global\fR \fIhiddenName \fR?\fIarg ..\fR? +\fIslave \fBinvokehidden\fR ?\fB-namespace\fR \fInamespace\fR? ?\fB-global\fR ?\fB\-\|\-\fR? \fIhiddenName \fR?\fIarg ..\fR? This command invokes the hidden command \fIhiddenName\fR with the supplied arguments, in \fIslave\fR. No substitutions or evaluations are applied to the arguments. +If the \fB-namespace\fR flag is given, the hidden command is invoked in +the specified namespace in the slave. If the \fB-global\fR flag is given, the command is invoked at the global level in the slave; otherwise it is invoked at the current call frame and can access local variables in that or outer call frames. +If both the \fB-namespace\fR and \fB-global\fR flags are given, the +\fB-namespace\fR flag is ignored. For more details on hidden commands, see HIDDEN COMMANDS, below. .TP diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 16d5052..004e34c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.110 2004/07/21 00:42:38 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.111 2004/08/02 20:55:36 dgp Exp $ */ #include "tclInt.h" @@ -1508,7 +1508,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc) if (strstr(cmdName, "::") != NULL) { TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL, - CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { return (Tcl_Command) NULL; } @@ -1663,7 +1663,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc) if (strstr(cmdName, "::") != NULL) { TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL, - CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { return (Tcl_Command) NULL; } @@ -2007,7 +2007,7 @@ TclRenameCommand(interp, oldName, newName) */ TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL, - CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); + TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -4390,6 +4390,10 @@ TclGlobalInvoke(interp, argc, argv, flags) * interpreter, thus it cannot see any current state on the * stack of that interpreter. * + * NOTE: This routine is no longer used at all by Tcl itself. + * It is kept only because it appears in the internal stub table, + * for the sake of any extensions that might be calling it. + * * Results: * A standard Tcl result. * @@ -4425,6 +4429,59 @@ TclObjInvokeGlobal(interp, objc, objv, flags) /* *---------------------------------------------------------------------- * + * TclObjInvokeNamespace -- + * + * Object version: Invokes a Tcl command, given an objv/objc, from + * either the exposed or hidden set of commands in the given + * interpreter. + * NOTE: The command is invoked in the global stack frame of the + * interpreter or namespace, thus it cannot see any current state on + * the stack of that interpreter. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Whatever the command does. + * + *---------------------------------------------------------------------- + */ + +int +TclObjInvokeNamespace(interp, objc, objv, nsPtr, flags) + Tcl_Interp *interp; /* Interpreter in which command is to be + * invoked. */ + int objc; /* Count of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the + * name of the command to invoke. */ + Tcl_Namespace *nsPtr; /* The namespace to use. */ + int flags; /* Combination of flags controlling the + * call: TCL_INVOKE_HIDDEN, + * TCL_INVOKE_NO_UNKNOWN, or + * TCL_INVOKE_NO_TRACEBACK. */ +{ + Tcl_CallFrame frame; + int result; + + /* + * Make the specified namespace the current namespace and invoke + * the command. + */ + + result = Tcl_PushCallFrame(interp, &frame, nsPtr, /*isProcCallFrame*/ 0); + if (result != TCL_OK) { + return TCL_ERROR; + } + + result = TclObjInvoke(interp, objc, objv, flags); + + Tcl_PopCallFrame(interp); + return result; +} + +/* + *---------------------------------------------------------------------- + * * TclObjInvoke -- * * Invokes a Tcl command, given an objv/objc, from either the @@ -4501,7 +4558,7 @@ TclObjInvoke(interp, objc, objv, flags) if (cmdPtr == NULL) { if (!(flags & TCL_INVOKE_NO_UNKNOWN)) { cmd = Tcl_FindCommand(interp, "unknown", - (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); + (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); if (cmd != (Tcl_Command) NULL) { cmdPtr = (Command *) cmd; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 0c5d431..620af26 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.170 2004/07/21 01:45:44 hobbs Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.171 2004/08/02 20:55:37 dgp Exp $ */ #ifndef _TCLINT @@ -247,15 +247,16 @@ typedef struct Namespace { #define NS_DEAD 0x02 /* - * Flag passed to TclGetNamespaceForQualName to have it create all namespace - * components of a namespace-qualified name that cannot be found. The new - * namespaces are created within their specified parent. Note that this - * flag's value must not conflict with the values of the flags - * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in - * tclNamesp.c). + * Flags passed to TclGetNamespaceForQualName: + * + * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. + * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. + * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. + * TCL_FIND_ONLY_NS - The name sought is a namespace name. */ -#define CREATE_NS_IF_UNKNOWN 0x800 +#define TCL_CREATE_NS_IF_UNKNOWN 0x800 +#define TCL_FIND_ONLY_NS 0x1000 /* *---------------------------------------------------------------- @@ -1797,6 +1798,9 @@ EXTERN int TclMergeReturnOptions _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr)); +EXTERN int TclObjInvokeNamespace _ANSI_ARGS_((Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[], + Tcl_Namespace *nsPtr, int flags)); EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src, int numBytes, int *readPtr, char *dst)); EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes, diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 405d4e8..12a2a8b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.42 2004/06/17 22:18:44 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.43 2004/08/02 20:55:37 dgp Exp $ */ #include "tclInt.h" @@ -297,8 +297,9 @@ static int SlaveHide _ANSI_ARGS_((Tcl_Interp *interp, static int SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Interp *slaveInterp)); static int SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Interp *slaveInterp, int global, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Interp *slaveInterp, + CONST char *namespaceName, + int objc, Tcl_Obj *CONST objv[])); static int SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Interp *slaveInterp)); static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy, @@ -779,16 +780,17 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) return TCL_OK; } case OPT_INVOKEHID: { - int i, index, global; + int i, index; + CONST char *namespaceName; Tcl_Interp *slaveInterp; static CONST char *hiddenOptions[] = { - "-global", "--", NULL + "-global", "-namespace", "--", NULL }; enum hiddenOption { - OPT_GLOBAL, OPT_LAST + OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST }; - global = 0; + namespaceName = NULL; for (i = 3; i < objc; i++) { if (Tcl_GetString(objv[i])[0] != '-') { break; @@ -798,23 +800,31 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } if (index == OPT_GLOBAL) { - global = 1; + namespaceName = "::"; } else { - i++; - break; + if (index == OPT_NAMESPACE) { + if (++i == objc) { /* There must be more arguments. */ + break; + } else { + namespaceName = Tcl_GetString(objv[i]); + } + } else { + i++; + break; + } } } if (objc - i < 1) { Tcl_WrongNumArgs(interp, 2, objv, - "path ?-global? ?--? cmd ?arg ..?"); + "path ?-namespace ns? ?-global? ?--? cmd ?arg ..?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == (Tcl_Interp *) NULL) { return TCL_ERROR; } - return SlaveInvokeHidden(interp, slaveInterp, global, objc - i, - objv + i); + return SlaveInvokeHidden(interp, slaveInterp, namespaceName, + objc - i, objv + i); } case OPT_LIMIT: { Tcl_Interp *slaveInterp; @@ -2184,14 +2194,16 @@ SlaveObjCmd(clientData, interp, objc, objv) return TCL_OK; } case OPT_INVOKEHIDDEN: { - int global, i, index; + int i, index; + CONST char *namespaceName; static CONST char *hiddenOptions[] = { - "-global", "--", NULL + "-global", "-namespace", "--", NULL }; enum hiddenOption { - OPT_GLOBAL, OPT_LAST + OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST }; - global = 0; + + namespaceName = NULL; for (i = 2; i < objc; i++) { if (Tcl_GetString(objv[i])[0] != '-') { break; @@ -2201,19 +2213,27 @@ SlaveObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } if (index == OPT_GLOBAL) { - global = 1; + namespaceName = "::"; } else { - i++; - break; + if (index == OPT_NAMESPACE) { + if (++i == objc) { /* There must be more arguments. */ + break; + } else { + namespaceName = Tcl_GetString(objv[i]); + } + } else { + i++; + break; + } } } if (objc - i < 1) { Tcl_WrongNumArgs(interp, 2, objv, - "?-global? ?--? cmd ?arg ..?"); + "?-namespace ns? ?-global? ?--? cmd ?arg ..?"); return TCL_ERROR; } - return SlaveInvokeHidden(interp, slaveInterp, global, objc - i, - objv + i); + return SlaveInvokeHidden(interp, slaveInterp, namespaceName, + objc - i, objv + i); } case OPT_LIMIT: { static CONST char *limitTypes[] = { @@ -2551,11 +2571,11 @@ SlaveHidden(interp, slaveInterp) */ static int -SlaveInvokeHidden(interp, slaveInterp, global, objc, objv) +SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv) Tcl_Interp *interp; /* Interp for error return. */ Tcl_Interp *slaveInterp; /* The slave interpreter in which command * will be invoked. */ - int global; /* Non-zero to invoke in global namespace. */ + CONST char *namespaceName; /* The namespace to use, if any. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { @@ -2571,11 +2591,20 @@ SlaveInvokeHidden(interp, slaveInterp, global, objc, objv) Tcl_Preserve((ClientData) slaveInterp); Tcl_AllowExceptions(slaveInterp); - if (global) { - result = TclObjInvokeGlobal(slaveInterp, objc, objv, - TCL_INVOKE_HIDDEN); - } else { + if (namespaceName == NULL) { result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN); + } else { + Namespace *nsPtr, *dummy1, *dummy2; + CONST char *tail; + + result = TclGetNamespaceForQualName(slaveInterp, namespaceName, + (Namespace *) NULL, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY + | TCL_LEAVE_ERR_MSG | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, + &dummy1, &dummy2, &tail); + if (result == TCL_OK) { + result = TclObjInvokeNamespace(slaveInterp, objc, objv, + (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN); + } } TclTransferResult(slaveInterp, result, interp); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index b1e2a8e..d30feea 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,21 +21,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.41 2004/07/11 23:11:22 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.42 2004/08/02 20:55:38 dgp Exp $ */ #include "tclInt.h" /* - * Flag passed to TclGetNamespaceForQualName to indicate that it should - * search for a namespace rather than a command or variable inside a - * namespace. Note that this flag's value must not conflict with the values - * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN. - */ - -#define FIND_ONLY_NS 0x1000 - -/* * Initial size of stack allocated space for tail list - used when resetting * shadowed command references in the functin: TclResetShadowedCmdRefs. */ @@ -606,7 +597,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) */ TclGetNamespaceForQualName(interp, name, (Namespace *) NULL, - /*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG), + /*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG), &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); /* @@ -1727,18 +1718,18 @@ DeleteImportedCmd(clientData) * TCL_NAMESPACE_ONLY are specified, TCL_GLOBAL_ONLY is ignored and * the search starts from the namespace specified by cxtNsPtr. * - * If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace + * If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, all namespace * components of the qualified name that cannot be found are * automatically created within their specified parent. This makes sure * that functions like Tcl_CreateCommand always succeed. There is no * alternate search path, so *altNsPtrPtr is set NULL. * - * If "flags" contains FIND_ONLY_NS, the qualified name is treated as a + * If "flags" contains TCL_FIND_ONLY_NS, the qualified name is treated as a * reference to a namespace, and the entire qualified name is * followed. If the name is relative, the namespace is looked up only * in the current namespace. A pointer to the namespace is stored in * *nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if - * FIND_ONLY_NS is not specified, only the leading components are + * TCL_FIND_ONLY_NS is not specified, only the leading components are * treated as namespace names, and a pointer to the simple name of the * final component is stored in *simpleNamePtr. * @@ -1749,7 +1740,7 @@ DeleteImportedCmd(clientData) * to NULL, then the search along that path failed. The procedure also * stores a pointer to the simple name of the final component in * *simpleNamePtr. If the qualified name is "::" or was treated as a - * namespace reference (FIND_ONLY_NS), the procedure stores a pointer + * namespace reference (TCL_FIND_ONLY_NS), the procedure stores a pointer * to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets * *simpleNamePtr to point to an empty string. * @@ -1766,7 +1757,7 @@ DeleteImportedCmd(clientData) * this function always returns TCL_OK. * * Side effects: - * If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be + * If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, new namespaces may be * created. * *---------------------------------------------------------------------- @@ -1787,8 +1778,8 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, int flags; /* Flags controlling the search: an OR'd * combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, - * CREATE_NS_IF_UNKNOWN, and - * FIND_ONLY_NS. */ + * TCL_CREATE_NS_IF_UNKNOWN, and + * TCL_FIND_ONLY_NS. */ Namespace **nsPtrPtr; /* Address where procedure stores a pointer * to containing namespace if qualName is * found starting from *cxtNsPtr or, if @@ -1801,8 +1792,8 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, * namespace. NULL is stored if qualName * isn't found starting from :: or if the * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag - * is set. */ + * TCL_CREATE_NS_IF_UNKNOWN, TCL_FIND_ONLY_NS + * flag is set. */ Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer * to the actual namespace from which the * search started. This is either cxtNsPtr, @@ -1812,7 +1803,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, CONST char **simpleNamePtr; /* Address where procedure stores the * simple name at end of the qualName, or * NULL if qualName is "::" or the flag - * FIND_ONLY_NS was specified. */ + * TCL_FIND_ONLY_NS was specified. */ { Interp *iPtr = (Interp *) interp; Namespace *nsPtr = cxtNsPtr; @@ -1826,7 +1817,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, /* * Determine the context namespace nsPtr in which to start the primary - * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search + * search. If TCL_NAMESPACE_ONLY or TCL_FIND_ONLY_NS was specified, search * from the current namespace. If the qualName name starts with a "::" * or TCL_GLOBAL_ONLY was specified, search from the global * namespace. Otherwise, use the given namespace given in cxtNsPtr, or @@ -1834,7 +1825,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, * always treat two or more adjacent ":"s as a namespace separator. */ - if (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS)) { + if (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS)) { nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); } else if (flags & TCL_GLOBAL_ONLY) { nsPtr = globalNsPtr; @@ -1872,7 +1863,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, altNsPtr = globalNsPtr; if ((nsPtr == globalNsPtr) - || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) { + || (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS))) { altNsPtr = NULL; } @@ -1905,12 +1896,12 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, if ((*end == '\0') && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) { /* - * qualName ended with a simple name at start. If FIND_ONLY_NS + * qualName ended with a simple name at start. If TCL_FIND_ONLY_NS * was specified, look this up as a namespace. Otherwise, * start is the name of a cmd or var and we are done. */ - if (flags & FIND_ONLY_NS) { + if (flags & TCL_FIND_ONLY_NS) { nsName = start; } else { *nsPtrPtr = nsPtr; @@ -1935,7 +1926,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, /* * Look up the namespace qualifier nsName in the current namespace - * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set, + * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set, * create that qualifying namespace. This is needed for procedures * like Tcl_CreateCommand that cannot fail. */ @@ -1944,7 +1935,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName); if (entryPtr != NULL) { nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); - } else if (flags & CREATE_NS_IF_UNKNOWN) { + } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame frame; (void) Tcl_PushCallFrame(interp, &frame, @@ -1995,7 +1986,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, * variable name, trailing "::"s refer to the cmd or var named {}. */ - if ((flags & FIND_ONLY_NS) + if ((flags & TCL_FIND_ONLY_NS) || ((end > start ) && (*(end-1) != ':'))) { *simpleNamePtr = NULL; /* found namespace name */ } else { @@ -2009,7 +2000,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, * namespaces can not have empty names except for the global namespace. */ - if ((flags & FIND_ONLY_NS) && (*qualName == '\0') + if ((flags & TCL_FIND_ONLY_NS) && (*qualName == '\0') && (nsPtr != globalNsPtr)) { nsPtr = NULL; } @@ -2061,12 +2052,12 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags) /* * Find the namespace(s) that contain the specified namespace name. - * Add the FIND_ONLY_NS flag to resolve the name all the way down + * Add the TCL_FIND_ONLY_NS flag to resolve the name all the way down * to its last component, a namespace. */ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, - (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + (flags | TCL_FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); if (nsPtr != NULL) { return (Tcl_Namespace *) nsPtr; @@ -4063,7 +4054,7 @@ SetNsNameFromAny(interp, objPtr) */ TclGetNamespaceForQualName(interp, name, (Namespace *) NULL, - FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); /* * If we found a namespace, then create a new ResolvedNsName structure diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 0e34ab6..dd0ee44 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTrace.c,v 1.10 2004/05/13 12:59:23 dkf Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.11 2004/08/02 20:55:38 dgp Exp $ */ #include "tclInt.h" @@ -2973,7 +2973,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) /* * We strip 'flags' down to just the parts which are relevant to * TclLookupVar, to avoid conflicts between trace flags and - * internal namespace flags such as 'FIND_ONLY_NS'. This can + * internal namespace flags such as 'TCL_FIND_ONLY_NS'. This can * now occur since we have trace flags with values 0x1000 and higher. */ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; diff --git a/tests/interp.test b/tests/interp.test index 0275e75..b60eb2c 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.38 2004/05/27 15:05:28 dkf Exp $ +# RCS: @(#) $Id: interp.test,v 1.39 2004/08/02 20:55:38 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1490,6 +1490,19 @@ test interp-20.48 {interp hide vs namespaces} { interp delete a set l } {1 {cannot use namespace qualifiers in hidden command token (rename)}} +test interp-20.49 {interp invokehidden -namespace} -setup { + set script [makeFile { + set x [namespace current] + } script] + interp create -safe slave +} -body { + slave invokehidden -namespace ::foo source $script + slave eval {set ::foo::x} +} -cleanup { + interp delete slave + removeFile script +} -result ::foo + test interp-21.1 {interp hidden} { interp hidden {} |