diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | doc/info.n | 13 | ||||
| -rw-r--r-- | doc/namespace.n | 36 | ||||
| -rw-r--r-- | generic/tclBasic.c | 5 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 130 | ||||
| -rw-r--r-- | generic/tclInt.h | 30 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 374 | ||||
| -rw-r--r-- | generic/tclResolve.c | 5 | ||||
| -rw-r--r-- | tests/info.test | 3 | ||||
| -rw-r--r-- | tests/namespace.test | 389 |
10 files changed, 953 insertions, 48 deletions
@@ -1,3 +1,19 @@ +2005-05-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + TIP #229 IMPLEMENTATION + + * generic/tclNamesp.c (Tcl_FindCommand, TclResetShadowedCmdRefs) + (NamespacePathCmd, SetNsPath, UnlinkNsPath, TclInvalidateNsPath): + Implementation of the [namespace path] command and the command + name resolution engine. + * doc/info.n, doc/namespace.n: Doc updates. + * tests/namespace.test (namespace-51.*): Test updates. + * generic/tclResolve.c (BumpCmdRefEpochs, Tcl_SetNamespaceResolvers): + * generic/tclBasic.c (Tcl_CreateCommand, Tcl_CreateObjCommand): + Ensure that people don't see stale paths. + * generic/tclInt.h (Namespace, NamespacePathEntry): Structure defs. + * generic/tclCmdIL.c (InfoCommandsCmd): Updates to [info commands]. + 2005-05-26 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: moved & corrected EMBEDDED_BUILD check. @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: info.n,v 1.16 2005/05/10 18:34:00 kennykb Exp $ +'\" RCS: @(#) $Id: info.n,v 1.17 2005/05/30 00:04:45 dkf Exp $ '\" .so man.macros .TH info n 8.4 Tcl "Tcl Built-In Commands" @@ -40,7 +40,10 @@ in this interpreter. .TP \fBinfo commands \fR?\fIpattern\fR? If \fIpattern\fR isn't specified, -returns a list of names of all the Tcl commands in the current namespace, +'\" Do not move this .VS above the .TP +.VS 8.5 +returns a list of names of all the Tcl commands visible +(i.e. executable without using a qualified name) to the current namespace, including both the built-in commands written in C and the command procedures defined using the \fBproc\fR command. If \fIpattern\fR is specified, @@ -53,7 +56,11 @@ and may have pattern matching special characters at the end to specify a set of commands in that namespace. If \fIpattern\fR is a qualified name, the resulting list of command names has each one qualified with the name -of the specified namespace. +of the specified namespace, and only the commands defined in the named +namespace are returned. +'\" Technically, most of this hasn't changed; that's mostly just the +'\" way it always worked. Hardly anyone knew that though. +.VE 8.5 .TP \fBinfo complete \fIcommand\fR Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of diff --git a/doc/namespace.n b/doc/namespace.n index 48c570a..60bd8e8 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -2,11 +2,12 @@ '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. +'\" Copyright (c) 2004-2005 Donal K. Fellows. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: namespace.n,v 1.17 2005/05/12 16:23:20 dgp Exp $ +'\" RCS: @(#) $Id: namespace.n,v 1.18 2005/05/30 00:04:45 dkf Exp $ '\" .so man.macros .TH namespace n 8.5 Tcl "Tcl Built-In Commands" @@ -216,6 +217,17 @@ for namespace \fInamespace\fR. If \fInamespace\fR is not specified, the fully-qualified name of the current namespace's parent is returned. .TP +\fBnamespace path\fR ?\fInamespaceList\fR? +'\" Should really have the .TP inside the .VS, but that triggers a groff bug +.VS 8.5 +Returns the command resolution path of the current namespace. If +\fInamespaceList\fR is specified as a list of named namespaces, the +current namespace's command resolution path is set to those namespaces +and returns the empty list. The default command resolution path is +always empty. See the section \fBNAME RESOLUTION\fR below for an +explanation of the rules regarding name resolution. +.VE 8.5 +.TP \fBnamespace qualifiers\fR \fIstring\fR Returns any leading namespace qualifiers for \fIstring\fR. Qualifiers are namespace names separated by double colons (\fB::\fR). @@ -387,10 +399,18 @@ there is no question about what command, variable, or namespace you mean. However, if the name does not start with a \fB::\fR (i.e., is \fIrelative\fR), -Tcl follows a fixed rule for looking it up: -Command and variable names are always resolved +Tcl follows basic rules for looking it up: +Variable names are always resolved by looking first in the current namespace, and then in the global namespace. +.VS 8.5 +Command names are also always resolved by looking in the current +namespace first. If not found there, they are searched for in every +namespace on the current namespace's command path (which is empty by +default). If not found there, command names are looked up in the +global namespace (or, failing that, are processed by the \fBunknown\fR +command.) +.VE 8.5 Namespace names, on the other hand, are always resolved by looking in only the current namespace. .PP @@ -764,10 +784,16 @@ Create a namespace containing a variable and an exported command: Call the command defined in the previous example in various ways. .CS # Direct call -foo::grill +::foo::grill + +# Use the command resolution path to find the name +\fBnamespace eval\fR boo { + \fBnamespace path\fR ::foo + grill +} # Import into current namespace, then call local alias -namespace import foo::grill +\fBnamespace import\fR foo::grill grill # Create two ensembles, one with the default name and one with a diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e526dc2..144b2f7 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.157 2005/05/25 16:13:17 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.158 2005/05/30 00:04:45 dkf Exp $ */ #include "tclInt.h" @@ -1579,6 +1579,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc) */ TclInvalidateNsCmdLookup(nsPtr); + TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); @@ -1703,6 +1704,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc) } hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new); + TclInvalidateNsPath(nsPtr); if (!new) { cmdPtr = (Command *) Tcl_GetHashValue(hPtr); @@ -1749,6 +1751,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc) */ TclInvalidateNsCmdLookup(nsPtr); + TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 7f67180..b68f7ba 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -11,11 +11,12 @@ * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.74 2005/05/10 18:34:08 kennykb Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.75 2005/05/30 00:04:46 dkf Exp $ */ #include "tclInt.h" @@ -712,6 +713,7 @@ InfoCommandsCmd(dummy, interp, objc, objv) Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0; /* Init. to avoid compiler warning. */ Tcl_Command cmd; + int i; /* * Get the pattern and find the "effective namespace" in which to @@ -779,16 +781,43 @@ InfoCommandsCmd(dummy, interp, objc, objv) elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); - } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable, - simplePattern); + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; + } + if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + Tcl_HashTable *tablePtr; + + for (i=0 ; i<nsPtr->commandPathLength ; i++) { + Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr; + + if (pathNsPtr == NULL) { + continue; + } + tablePtr = &pathNsPtr->cmdTable; + entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); + if (entryPtr != NULL) { + break; + } + } + if (entryPtr == NULL) { + tablePtr = &globalNsPtr->cmdTable; + entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); + } if (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + cmdName = Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; } } - } else { + } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) { + /* + * The pattern is non-trivial, but either there is no explicit + * path or there is an explicit namespace in the pattern. In + * both cases, the old matching scheme is perfect. + */ + entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); @@ -828,6 +857,95 @@ InfoCommandsCmd(dummy, interp, objc, objv) entryPtr = Tcl_NextHashEntry(&search); } } + } else { + /* + * The pattern is non-trivial (can match more than one command + * name), there is an explicit path, and there is no explicit + * namespace in the pattern. This means that we have to + * traverse the path to discover all the commands defined. + */ + + Tcl_HashTable addedCommandsTable; + int isNew; + int foundGlobal = (nsPtr == globalNsPtr); + + /* + * We keep a hash of the objects already added to the result + * list. + */ + Tcl_InitObjHashTable(&addedCommandsTable); + + entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); + while (entryPtr != NULL) { + cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(cmdName, simplePattern)) { + elemObjPtr = Tcl_NewStringObj(cmdName, -1); + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + (void) Tcl_CreateHashEntry(&addedCommandsTable, + (char *)elemObjPtr, &isNew); + } + entryPtr = Tcl_NextHashEntry(&search); + } + + /* + * Search the path next. + */ + + for (i=0 ; i<nsPtr->commandPathLength ; i++) { + Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr; + + if (pathNsPtr == NULL) { + continue; + } + if (pathNsPtr == globalNsPtr) { + foundGlobal = 1; + } + entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search); + while (entryPtr != NULL) { + cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(cmdName, simplePattern)) { + elemObjPtr = Tcl_NewStringObj(cmdName, -1); + (void) Tcl_CreateHashEntry(&addedCommandsTable, + (char *) elemObjPtr, &isNew); + if (isNew) { + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } else { + TclDecrRefCount(elemObjPtr); + } + } + entryPtr = Tcl_NextHashEntry(&search); + } + } + + /* + * If the effective namespace isn't the global :: namespace, and a + * specific namespace wasn't requested in the pattern, then add in + * all global :: commands that match the simple pattern. Of course, + * we add in only those commands that aren't hidden by a command in + * the effective namespace. + */ + + if (!foundGlobal) { + entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); + while (entryPtr != NULL) { + cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(cmdName, simplePattern)) { + elemObjPtr = Tcl_NewStringObj(cmdName, -1); + if (Tcl_FindHashEntry(&addedCommandsTable, + (char *) elemObjPtr) == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } else { + TclDecrRefCount(elemObjPtr); + } + } + entryPtr = Tcl_NextHashEntry(&search); + } + } + + Tcl_DeleteHashTable(&addedCommandsTable); } Tcl_SetObjResult(interp, listPtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index a739fe8..7efd7c1 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.231 2005/05/23 20:19:45 das Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.232 2005/05/30 00:04:47 dkf Exp $ */ #ifndef _TCLINT @@ -131,6 +131,7 @@ typedef struct Tcl_ResolverInfo { */ typedef struct Tcl_Ensemble Tcl_Ensemble; +typedef struct NamespacePathEntry NamespacePathEntry; /* * The structure below defines a namespace. @@ -233,9 +234,35 @@ typedef struct Namespace { Tcl_Ensemble *ensembles; /* List of structures that contain the details * of the ensembles that are implemented on * top of this namespace. */ + int commandPathLength; /* The length of the explicit path. */ + NamespacePathEntry *commandPathArray; + /* The explicit path of the namespace as an + * array. */ + NamespacePathEntry *commandPathSourceList; + /* Linked list of path entries that point to + * this namespace. */ } Namespace; /* + * An entry on a namespace's command resolution path. + */ + +struct NamespacePathEntry { + Namespace *nsPtr; /* What does this path entry point to? If it + *is NULL, this path entry points is redundant + * and should be skipped. */ + Namespace *creatorNsPtr; /* Where does this path entry point from? This + * allows for efficient invalidation of + * references when the path entry's target + * updates its current list of defined + * commands. */ + NamespacePathEntry *prevPtr, *nextPtr; + /* Linked list pointers or NULL at either end + * of the list that hangs off Namespace's + * commandPathSourceList field. */ +}; + +/* * Flags used to represent the status of a namespace: * * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the @@ -2442,6 +2469,7 @@ MODULE_SCOPE Tcl_Obj * TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST Tcl_WideInt i, CONST int flags)); +MODULE_SCOPE void TclInvalidateNsPath _ANSI_ARGS_((Namespace *nsPtr)); /* *---------------------------------------------------------------- diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 61329d3..c49bd43 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,7 +21,7 @@ * 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.75 2005/05/19 22:49:01 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.76 2005/05/30 00:04:48 dkf Exp $ */ #include "tclInt.h" @@ -242,6 +242,9 @@ static int NamespaceOriginCmd _ANSI_ARGS_(( static int NamespaceParentCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int NamespacePathCmd _ANSI_ARGS_(( + ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static int NamespaceQualifiersCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -270,6 +273,9 @@ static void FreeEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static void DupEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)); static void StringOfEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void UnlinkNsPath _ANSI_ARGS_((Namespace *nsPtr)); +static void SetNsPath _ANSI_ARGS_((Namespace *nsPtr, + int pathLength, Tcl_Namespace *pathAry[])); /* * This structure defines a Tcl object type that contains a @@ -844,6 +850,9 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) nsPtr->compiledVarResProc = NULL; nsPtr->exportLookupEpoch = 0; nsPtr->ensembles = NULL; + nsPtr->commandPathLength = 0; + nsPtr->commandPathArray = NULL; + nsPtr->commandPathSourceList = NULL; if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, @@ -1065,6 +1074,22 @@ TclTeardownNamespace(nsPtr) nsPtr->parentPtr = NULL; /* + * Delete the namespace path if one is installed. + */ + + if (nsPtr->commandPathLength != 0) { + UnlinkNsPath(nsPtr); + nsPtr->commandPathLength = 0; + } + if (nsPtr->commandPathSourceList != NULL) { + NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList; + do { + nsPathPtr->nsPtr = NULL; + nsPathPtr = nsPathPtr->nextPtr; + } while (nsPathPtr != NULL); + } + + /* * Delete all the child namespaces. * * BE CAREFUL: When each child is deleted, it will divorce @@ -2309,15 +2334,11 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * ignored. */ { Interp *iPtr = (Interp*)interp; - - ResolverScheme *resPtr; - Namespace *nsPtr[2], *cxtNsPtr; - CONST char *simpleName; + Namespace *cxtNsPtr; register Tcl_HashEntry *entryPtr; register Command *cmdPtr; - register int search; + CONST char *simpleName; int result; - Tcl_Command cmd; /* * If this namespace has a command resolver, then give it first @@ -2326,7 +2347,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * procedures may return a Tcl_Command value, they may signal * to continue onward, or they may signal an error. */ - if ((flags & TCL_GLOBAL_ONLY) != 0) { + if (flags & TCL_GLOBAL_ONLY) { cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); } else if (contextNsPtr != NULL) { cxtNsPtr = (Namespace *) contextNsPtr; @@ -2335,7 +2356,8 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) } if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) { - resPtr = iPtr->resolverPtr; + ResolverScheme *resPtr = iPtr->resolverPtr; + Tcl_Command cmd; if (cxtNsPtr->cmdResProc) { result = (*cxtNsPtr->cmdResProc)(interp, name, @@ -2363,33 +2385,90 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * Find the namespace(s) that contain the command. */ - TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, - flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); - - /* - * Look for the command in the command table of its namespace. - * Be sure to check both possible search paths: from the specified - * namespace context and from the global namespace. - */ - cmdPtr = NULL; - for (search = 0; (search < 2) && (cmdPtr == NULL); search++) { - if ((nsPtr[search] != NULL) && (simpleName != NULL)) { - entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, - simpleName); + if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)) { + int i; + Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; + + (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, + TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, + &simpleName); + if (realNsPtr != NULL && simpleName != NULL) { + entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } + + /* + * Next, check along the path. + */ + + for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) { + pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr; + if (pathNsPtr == NULL) { + continue; + } + (void) TclGetNamespaceForQualName(interp, name, pathNsPtr, + TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, + &simpleName); + if (realNsPtr != NULL && simpleName != NULL) { + entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); + if (entryPtr != NULL) { + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + } + } + } + + /* + * If we've still not found the command, look in the global + * namespace as a last resort. + */ + + if (cmdPtr == NULL) { + (void) TclGetNamespaceForQualName(interp, name, NULL, + TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, + &simpleName); + if (realNsPtr != NULL && simpleName != NULL) { + entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); + if (entryPtr != NULL) { + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + } + } + } + } else { + Namespace *nsPtr[2]; + register int search; + + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, + flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); + + /* + * Look for the command in the command table of its namespace. + * Be sure to check both possible search paths: from the + * specified namespace context and from the global namespace. + */ + + for (search = 0; (search < 2) && (cmdPtr == NULL); search++) { + if ((nsPtr[search] != NULL) && (simpleName != NULL)) { + entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, + simpleName); + if (entryPtr != NULL) { + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + } + } + } } + if (cmdPtr != NULL) { return (Tcl_Command) cmdPtr; - } else if (flags & TCL_LEAVE_ERR_MSG) { + } + + if (flags & TCL_LEAVE_ERR_MSG) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unknown command \"", name, "\"", (char *) NULL); } - return (Tcl_Command) NULL; } @@ -2628,6 +2707,7 @@ TclResetShadowedCmdRefs(interp, newCmdPtr) hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName); if (hPtr != NULL) { nsPtr->cmdRefEpoch++; + TclInvalidateNsPath(nsPtr); /* * If the shadowed command was compiled to bytecodes, we @@ -2831,13 +2911,13 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv) static CONST char *subCmds[] = { "children", "code", "current", "delete", "ensemble", "eval", "exists", "export", "forget", "import", - "inscope", "origin", "parent", "qualifiers", + "inscope", "origin", "parent", "path", "qualifiers", "tail", "which", (char *) NULL }; enum NSSubCmdIdx { NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx, NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx, - NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx, + NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx, NSTailIdx, NSWhichIdx }; int index, result; @@ -2897,6 +2977,9 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv) case NSParentIdx: result = NamespaceParentCmd(clientData, interp, objc, objv); break; + case NSPathIdx: + result = NamespacePathCmd(clientData, interp, objc, objv); + break; case NSQualifiersIdx: result = NamespaceQualifiersCmd(clientData, interp, objc, objv); break; @@ -3906,6 +3989,245 @@ NamespaceParentCmd(dummy, interp, objc, objv) /* *---------------------------------------------------------------------- * + * NamespacePathCmd -- + * + * Invoked to implement the "namespace path" command that reads + * and writes the current namespace's command resolution path. + * Has one optional argument: if present, it is a list of named + * namespaces to set the path to, and if absent, the current path + * should be returned. Handles the following syntax: + * + * namespace path ?nsList? + * + * Results: + * Returns TCL_OK if successful, and TCL_ERROR if anything goes + * wrong (most notably if the namespace list contains the name of + * something other than a namespace). In the successful-exit + * case, may set the interpreter result to the list of names of + * the namespaces on the current namespace's path. + * + * Side effects: + * May update the namespace path (triggering a recomputing of all + * command names that depend on the namespace for resolution). + * + *---------------------------------------------------------------------- + */ + +static int +NamespacePathCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + int i, nsObjc, result = TCL_ERROR; + Tcl_Obj **nsObjv; + Tcl_Namespace **namespaceList = NULL; + Tcl_Namespace *staticNs[4]; + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?pathList?"); + return TCL_ERROR; + } + + /* + * If no path is given, return the current path. + */ + + if (objc == 2) { + /* + * Not a very fast way to compute this, but easy to get right. + */ + for (i=0 ; i<nsPtr->commandPathLength ; i++) { + if (nsPtr->commandPathArray[i].nsPtr != NULL) { + Tcl_AppendElement(interp, + nsPtr->commandPathArray[i].nsPtr->fullName); + } + } + return TCL_OK; + } + + /* + * There is a path given, so parse it into an array of namespace + * pointers. + */ + + if (Tcl_ListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) { + goto badNamespace; + } + if (nsObjc != 0) { + if (nsObjc > 4) { + namespaceList = (Tcl_Namespace **) + ckalloc(sizeof(Tcl_Namespace *) * nsObjc); + } else { + namespaceList = staticNs; + } + + for (i=0 ; i<nsObjc ; i++) { + if (TclGetNamespaceFromObj(interp, nsObjv[i], + &namespaceList[i]) != TCL_OK) { + goto badNamespace; + } + if (namespaceList[i] == NULL) { + Tcl_AppendResult(interp, "unknown namespace \"", + TclGetString(nsObjv[i]), "\"", NULL); + goto badNamespace; + } + } + } + + /* + * Now we have the list of valid namespaces, install it as the + * path. + */ + + SetNsPath(nsPtr, nsObjc, namespaceList); + + result = TCL_OK; + badNamespace: + if (namespaceList != NULL && namespaceList != staticNs) { + ckfree((char *) namespaceList); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * SetNsPath -- + * + * Sets the namespace command name resolution path to the given + * list of namespaces. If the list is empty (of zero length) the + * path is set to empty and the default old-style behaviour of + * command name resolution is used. + * + * Results: + * nothing + * + * Side effects: + * Invalidates the command name resolution caches for any command + * resolved in the given namespace. + * + *---------------------------------------------------------------------- + */ + +/* EXPOSE ME? */ +static void +SetNsPath(nsPtr, pathLength, pathAry) + Namespace *nsPtr; /* Namespace whose path is to be set. */ + int pathLength; /* Length of pathAry */ + Tcl_Namespace *pathAry[]; /* Array of namespaces that are the path. */ +{ + NamespacePathEntry *tmpPathArray; + int i; + + if (pathLength != 0) { + tmpPathArray = (NamespacePathEntry *) + ckalloc(sizeof(NamespacePathEntry) * pathLength); + for (i=0 ; i<pathLength ; i++) { + tmpPathArray[i].nsPtr = (Namespace *) pathAry[i]; + tmpPathArray[i].creatorNsPtr = nsPtr; + tmpPathArray[i].prevPtr = NULL; + tmpPathArray[i].nextPtr = + tmpPathArray[i].nsPtr->commandPathSourceList; + if (tmpPathArray[i].nextPtr != NULL) { + tmpPathArray[i].nextPtr->prevPtr = &tmpPathArray[i]; + } + tmpPathArray[i].nsPtr->commandPathSourceList = &tmpPathArray[i]; + } + if (nsPtr->commandPathLength != 0) { + UnlinkNsPath(nsPtr); + } + nsPtr->commandPathArray = tmpPathArray; + } else { + if (nsPtr->commandPathLength != 0) { + UnlinkNsPath(nsPtr); + } + } + + nsPtr->commandPathLength = pathLength; + nsPtr->cmdRefEpoch++; + nsPtr->resolverEpoch++; +} + +/* + *---------------------------------------------------------------------- + * + * UnlinkNsPath -- + * + * Delete the given namespace's command name resolution path. Only + * call if the path is non-empty. Caller must reset the counter + * containing the path size. + * + * Results: + * nothing + * + * Side effects: + * Deletes the array of path entries and unlinks those path entries + * from the target namespace's list of interested namespaces. + * + *---------------------------------------------------------------------- + */ + +static void +UnlinkNsPath(nsPtr) + Namespace *nsPtr; +{ + int i; + for (i=0 ; i<nsPtr->commandPathLength ; i++) { + NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; + if (nsPathPtr->prevPtr != NULL) { + nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr; + } + if (nsPathPtr->nextPtr != NULL) { + nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr; + } + if (nsPathPtr->nsPtr != NULL) { + if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) { + nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr; + } + } + } + ckfree((char *) nsPtr->commandPathArray); +} + +/* + *---------------------------------------------------------------------- + * + * TclInvalidateNsPath -- + * + * Invalidate the name resolution caches for all names looked up + * in namespaces whose name path includes the given namespace. + * + * Results: + * nothing + * + * Side effects: + * Increments the command reference epoch in each namespace whose + * path includes the given namespace. This causes any cached + * resolved names whose root cacheing context starts at that + * namespace to be recomputed the next time they are used. + * + *---------------------------------------------------------------------- + */ + +void +TclInvalidateNsPath(nsPtr) + Namespace *nsPtr; +{ + NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList; + while (nsPathPtr != NULL) { + if (nsPathPtr->nsPtr != NULL) { + nsPathPtr->creatorNsPtr->cmdRefEpoch++; + } + nsPathPtr = nsPathPtr->nextPtr; + } +} + +/* + *---------------------------------------------------------------------- + * * NamespaceQualifiersCmd -- * * Invoked to implement the "namespace qualifiers" command that returns diff --git a/generic/tclResolve.c b/generic/tclResolve.c index 4386c3d..49c21ca 100644 --- a/generic/tclResolve.c +++ b/generic/tclResolve.c @@ -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: tclResolve.c,v 1.4 2002/01/25 22:01:32 dgp Exp $ + * RCS: @(#) $Id: tclResolve.c,v 1.5 2005/05/30 00:04:48 dkf Exp $ */ #include "tclInt.h" @@ -273,8 +273,8 @@ BumpCmdRefEpochs(nsPtr) childNsPtr = (Namespace *) Tcl_GetHashValue(entry); BumpCmdRefEpochs(childNsPtr); } + TclInvalidateNsPath(nsPtr); } - /* *---------------------------------------------------------------------- @@ -369,6 +369,7 @@ Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc) nsPtr->cmdRefEpoch++; nsPtr->resolverEpoch++; + TclInvalidateNsPath(nsPtr); } /* diff --git a/tests/info.test b/tests/info.test index 3441a3b..7295750 100644 --- a/tests/info.test +++ b/tests/info.test @@ -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: info.test,v 1.30 2005/05/25 16:13:17 dgp Exp $ +# RCS: @(#) $Id: info.test,v 1.31 2005/05/30 00:04:48 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -151,6 +151,7 @@ catch {rename _t2_ {}} test info-4.5 {info commands option} { list [catch {info commands a b} msg] $msg } {1 {wrong # args: should be "info commands ?pattern?"}} +# Also some tests in namespace.test test info-5.1 {info complete option} { list [catch {info complete} msg] $msg diff --git a/tests/namespace.test b/tests/namespace.test index 9341ecf..c611e9c 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -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: namespace.test,v 1.43 2004/10/29 15:39:10 dkf Exp $ +# RCS: @(#) $Id: namespace.test,v 1.44 2005/05/30 00:04:49 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -838,7 +838,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} { list [catch {namespace wombat {}} msg] $msg -} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} +} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} @@ -945,7 +945,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} { } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} { list [catch {namespace test_ns_1} msg] $msg -} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} +} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 @@ -1956,6 +1956,389 @@ test namespace-50.4 {chained ensembles affect error messages} -body { rename a {} } +test namespace-51.1 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + namespace path ::test_ns_1 + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + test_ns_1::test_ns_2::pathtestA +} -result "global,2,global," -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.2 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + namespace path ::test_ns_1 + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + ::test_ns_1::test_ns_2::pathtestA +} -result "1,2,global,::test_ns_1" -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.3 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + set result [::test_ns_1::test_ns_2::pathtestA] + namespace eval ::test_ns_1::test_ns_2 { + namespace path ::test_ns_1 + } + lappend result [::test_ns_1::test_ns_2::pathtestA] + rename ::test_ns_1::pathtestB {} + lappend result [::test_ns_1::test_ns_2::pathtestA] +} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.4 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + set result [::test_ns_1::test_ns_2::pathtestA] + namespace eval ::test_ns_1::test_ns_2 { + namespace path ::test_ns_1 + } + lappend result [::test_ns_1::test_ns_2::pathtestA] + namespace eval ::test_ns_1::test_ns_2 { + namespace path {} + } + lappend result [::test_ns_1::test_ns_2::pathtestA] +} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.5 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + namespace path ::test_ns_1 + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + proc pathtestD {} { + return 1 + } + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + set result [::test_ns_1::test_ns_2::pathtestA] + namespace eval ::test_ns_1::test_ns_2 { + namespace path {:: ::test_ns_1} + } + lappend result [::test_ns_1::test_ns_2::pathtestA] + rename ::test_ns_1::test_ns_2::pathtestC {} + lappend result [::test_ns_1::test_ns_2::pathtestA] +} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.6 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc pathtestA {} { + ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] + } + proc pathtestC {} { + ::return 2 + } + namespace path ::test_ns_1 + } + proc pathtestB {} { + return 1 + } + proc pathtestC {} { + return 1 + } + proc pathtestD {} { + return 1 + } + } + proc ::pathtestB {} { + return global + } + proc ::pathtestD {} { + return global + } + set result [::test_ns_1::test_ns_2::pathtestA] + namespace eval ::test_ns_1::test_ns_2 { + namespace path {:: ::test_ns_1} + } + lappend result [::test_ns_1::test_ns_2::pathtestA] + rename ::test_ns_1::test_ns_2::pathtestC {} + lappend result [::test_ns_1::test_ns_2::pathtestA] + proc ::pathtestC {} { + return global + } + lappend result [::test_ns_1::test_ns_2::pathtestA] +} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup { + namespace delete ::test_ns_1 + catch {rename ::pathtestB {}} + catch {rename ::pathtestD {}} +} +test namespace-51.7 {name resolution path control} -body { + namespace eval ::test_ns_1 { + } + namespace eval ::test_ns_2 { + namespace path ::test_ns_1 + proc getpath {} {namespace path} + } + list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath] +} -result {::test_ns_1 {} {}} -cleanup { + catch {namespace delete ::test_ns_1} + namespace delete ::test_ns_2 +} +test namespace-51.8 {name resolution path control} -body { + namespace eval ::test_ns_1 { + } + namespace eval ::test_ns_2 { + } + namespace eval ::test_ns_3 { + } + namespace eval ::test_ns_4 { + namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} + proc getpath {} {namespace path} + } + list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath] +} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} + catch {namespace delete ::test_ns_4} +} +test namespace-51.9 {name resolution path control} -body { + namespace eval ::test_ns_1 { + } + namespace eval ::test_ns_2 { + } + namespace eval ::test_ns_3 { + } + namespace eval ::test_ns_4 { + namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} + proc getpath {} {namespace path} + } + list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath] +} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} + catch {namespace delete ::test_ns_4} +} +test namespace-51.10 {name resolution path control} -body { + namespace eval ::test_ns_1 { + namespace path does::not::exist + } +} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup { + catch {namespace delete ::test_ns_1} +} +test namespace-51.11 {name resolution path control} -body { + namespace eval ::test_ns_1 { + proc foo {} {return 1} + } + namespace eval ::test_ns_2 { + proc foo {} {return 2} + } + namespace eval ::test_ns_3 { + namespace path ::test_ns_1 + } + namespace eval ::test_ns_4 { + namespace path {::test_ns_3 ::test_ns_2} + foo + } +} -result 2 -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} + catch {namespace delete ::test_ns_4} +} +test namespace-51.12 {name resolution path control} -body { + namespace eval ::test_ns_1 { + proc foo {} {return 1} + } + namespace eval ::test_ns_2 { + proc foo {} {return 2} + } + namespace eval ::test_ns_3 { + namespace path ::test_ns_1 + } + namespace eval ::test_ns_4 { + namespace path {::test_ns_3 ::test_ns_2} + list [foo] [namespace delete ::test_ns_3] [foo] + } +} -result {2 {} 2} -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} + catch {namespace delete ::test_ns_4} +} +# Fails right now due to unrelated bug... +test namespace-51.13 {name resolution path control} -constraints knownBug -body { + set ::result {} + namespace eval ::test_ns_1 { + proc foo {} {lappend ::result 1} + } + namespace eval ::test_ns_2 { + proc foo {} {lappend ::result 2} + trace add command foo delete {namespace eval ::test_ns_3 foo;#} + } + namespace eval ::test_ns_3 { + proc foo {} { + lappend ::result 3 + namespace delete [namespace current] + ::test_ns_4::bar + } + } + namespace eval ::test_ns_4 { + namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1} + proc bar {} { + list [foo] [namespace delete ::test_ns_2] [foo] + } + bar + } + # Should the result be "2 {} {2 3 1 1}" instead? +} -result {2 {} {2 3 2 1}} -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} + catch {namespace delete ::test_ns_4} +} +test namespace-51.14 {name resolution path control} -body { + proc foo0 {} {} + namespace eval ::test_ns_1 { + proc foo1 {} {} + } + namespace eval ::test_ns_2 { + proc foo2 {} {} + } + namespace eval ::test_ns_3 { + variable result {} + lappend result [info commands foo*] + namespace path {::test_ns_1 ::test_ns_2} + lappend result [info commands foo*] + proc foo2 {} {} + lappend result [info commands foo*] + rename foo2 {} + lappend result [info commands foo*] + namespace delete ::test_ns_1 + lappend result [info commands foo*] + } +} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup { + catch {namespace delete ::test_ns_1} + catch {namespace delete ::test_ns_2} + catch {namespace delete ::test_ns_3} +} +test namespace-51.15 {namespace resolution path control} -body { + namespace eval ::test_ns_2 { + proc foo {} {return 2} + } + namespace eval ::test_ns_1 { + namespace eval test_ns_2 { + proc foo {} {return 1_2} + } + namespace eval test_ns_3 { + namespace path ::test_ns_1 + test_ns_2::foo + } + } +} -result 1_2 -cleanup { + namespace delete ::test_ns_1 + namespace delete ::test_ns_2 +} + # cleanup catch {rename cmd1 {}} catch {unset l} |