summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-08-02 20:55:25 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-08-02 20:55:25 (GMT)
commit7659a2e96a1878dd2f0bb5111c39a0d4e0b2923d (patch)
treef85c32954ee501d185c1c8a08b0c40030be082b6
parent3fa3ba646929ac210ff9b90aae5b4483dcf4878f (diff)
downloadtcl-7659a2e96a1878dd2f0bb5111c39a0d4e0b2923d.zip
tcl-7659a2e96a1878dd2f0bb5111c39a0d4e0b2923d.tar.gz
tcl-7659a2e96a1878dd2f0bb5111c39a0d4e0b2923d.tar.bz2
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]
-rw-r--r--ChangeLog10
-rw-r--r--doc/interp.n14
-rw-r--r--generic/tclBasic.c67
-rw-r--r--generic/tclInt.h20
-rw-r--r--generic/tclInterp.c87
-rw-r--r--generic/tclNamesp.c57
-rw-r--r--generic/tclTrace.c4
-rw-r--r--tests/interp.test15
8 files changed, 193 insertions, 81 deletions
diff --git a/ChangeLog b/ChangeLog
index 4338ba3..625ddca 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 {}