diff options
| -rw-r--r-- | generic/tclBasic.c | 10 | ||||
| -rw-r--r-- | generic/tclDisassemble.c | 2 | ||||
| -rw-r--r-- | generic/tclEnsemble.c | 35 | ||||
| -rw-r--r-- | generic/tclExecute.c | 25 | ||||
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 603 | ||||
| -rw-r--r-- | generic/tclOOBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclOODefineCmds.c | 2 | ||||
| -rw-r--r-- | generic/tclOOInfo.c | 3 |
9 files changed, 362 insertions, 323 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f971080..1878d27 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8870,7 +8870,7 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Obj *listPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* @@ -8878,9 +8878,8 @@ TclNRTailcallObjCmd( * namespace, the rest the command to be tailcalled. */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); listPtr = Tcl_NewListObj(objc, objv); - TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + TclListObjSetElement(NULL, listPtr, 0, TclNewNamespaceObj(nsPtr)); iPtr->varFramePtr->tailcallPtr = listPtr; } @@ -9033,8 +9032,8 @@ TclNRYieldToObjCmd( Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; - Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp); + Tcl_Obj *listPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); @@ -9063,8 +9062,7 @@ TclNRYieldToObjCmd( */ listPtr = Tcl_NewListObj(objc, objv); - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); - TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + TclListObjSetElement(NULL, listPtr, 0, TclNewNamespaceObj(nsPtr)); /* * Add the callback in the caller's env, then instruct TEBC to yield. diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index f78666c..6b0b5f1 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -1231,7 +1231,7 @@ DisassembleByteCodeAsDicts( TclDictPut(NULL, description, "script", Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes)); TclDictPut(NULL, description, "namespace", - Tcl_NewStringObj(codePtr->nsPtr->fullName, -1)); + TclNewNamespaceObj((Tcl_Namespace *) codePtr->nsPtr)); TclDictPut(NULL, description, "stackdepth", Tcl_NewWideIntObj(codePtr->maxStackDepth)); TclDictPut(NULL, description, "exceptdepth", diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 915a916..7b251eb 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -17,7 +17,6 @@ * Declarations for functions local to this file: */ -static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr); static Tcl_Command InitEnsembleFromOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ReadOneEnsembleOption(Tcl_Interp *interp, @@ -129,30 +128,6 @@ typedef struct { /* *---------------------------------------------------------------------- * - * NewNsObj -- - * - * Make an object that contains a namespace's name. - * - * TODO: - * This is a candidate for doing something better! - * - *---------------------------------------------------------------------- - */ -static inline Tcl_Obj * -NewNsObj( - Tcl_Namespace *namespacePtr) -{ - Namespace *nsPtr = (Namespace *) namespacePtr; - - if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { - return Tcl_NewStringObj("::", 2); - } - return Tcl_NewStringObj(nsPtr->fullName, TCL_AUTO_LENGTH); -} - -/* - *---------------------------------------------------------------------- - * * TclNamespaceEnsembleCmd -- * * Invoked to implement the "namespace ensemble" command that creates and @@ -369,7 +344,8 @@ InitEnsembleFromOptions( cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_NewListObj(len, listv); - Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr); + Tcl_Obj *newCmd = TclNewNamespaceObj( + (Tcl_Namespace *) nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", (char *)NULL); @@ -492,7 +468,7 @@ ReadOneEnsembleOption( case CONF_NAMESPACE: { Tcl_Namespace *namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); - Tcl_SetObjResult(interp, NewNsObj(namespacePtr)); + Tcl_SetObjResult(interp, TclNewNamespaceObj(namespacePtr)); break; } case CONF_PREFIX: { @@ -552,7 +528,7 @@ ReadAllEnsembleOptions( Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE], TCL_AUTO_LENGTH)); Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); - Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr)); + Tcl_ListObjAppendElement(NULL, resultObj, TclNewNamespaceObj(namespacePtr)); /* -parameters option */ Tcl_ListObjAppendElement(NULL, resultObj, @@ -690,7 +666,8 @@ SetEnsembleConfigOptions( cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_DuplicateObj(listObj); - Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*) nsPtr); + Tcl_Obj *newCmd = TclNewNamespaceObj( + (Tcl_Namespace*) nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", (char *)NULL); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f6a18f7..6910c29 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2470,7 +2470,7 @@ TEBCresume( } case INST_TAILCALL: { - Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Obj *listPtr; opnd = TclGetUInt1AtPtr(pc+1); @@ -2506,8 +2506,8 @@ TEBCresume( */ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); - nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); - TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + TclListObjSetElement(NULL, listPtr, 0, TclNewNamespaceObj( + (Tcl_Namespace *) iPtr->varFramePtr->nsPtr)); if (iPtr->varFramePtr->tailcallPtr) { Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); } @@ -4315,18 +4315,10 @@ TEBCresume( * Start of general introspector instructions. */ - case INST_NS_CURRENT: { - Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - - if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { - TclNewLiteralStringObj(objResultPtr, "::"); - } else { - TclNewStringObj(objResultPtr, currNsPtr->fullName, - strlen(currNsPtr->fullName)); - } + case INST_NS_CURRENT: + objResultPtr = TclNewNamespaceObj(TclGetCurrentNamespace(interp)); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); - } break; case INST_COROUTINE_NAME: { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; @@ -4683,12 +4675,7 @@ TEBCresume( goto gotError; } - /* - * TclOO objects *never* have the global namespace as their NS. - */ - - TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName, - strlen(oPtr->namespacePtr->fullName)); + objResultPtr = TclNewNamespaceObj(oPtr->namespacePtr); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); } diff --git a/generic/tclInt.h b/generic/tclInt.h index d397879..7cbb3f1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3535,6 +3535,7 @@ MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); +MODULE_SCOPE Tcl_Obj * TclNewNamespaceObj(Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclpAlertNotifier(void *clientData); MODULE_SCOPE void * TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index eebf6aa..978639e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -76,10 +76,11 @@ static int DoImport(Tcl_Interp *interp, Namespace *nsPtr, Tcl_HashEntry *hPtr, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite); -static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr); -static char * ErrorCodeRead(void *clientData,Tcl_Interp *interp, +static void DupNsNameInternalRep(Tcl_Obj *objPtr, + Tcl_Obj *copyPtr); +static char * ErrorCodeRead(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); -static char * ErrorInfoRead(void *clientData,Tcl_Interp *interp, +static char * ErrorInfoRead(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * EstablishErrorCodeTraces(void *clientData, Tcl_Interp *interp, const char *name1, @@ -91,7 +92,8 @@ static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedNRCmd(void *clientData, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static Tcl_ObjCmdProc NamespaceChildrenCmd; static Tcl_ObjCmdProc NamespaceCodeCmd; static Tcl_ObjCmdProc NamespaceCurrentCmd; @@ -134,20 +136,20 @@ static const Tcl_ObjType nsNameType = { TCL_OBJTYPE_V0 }; -#define NsNameSetInternalRep(objPtr, nnPtr) \ +#define NsNameSetInternalRep(objPtr, nnPtr) \ do { \ Tcl_ObjInternalRep ir; \ (nnPtr)->refCount++; \ ir.twoPtrValue.ptr1 = (nnPtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &nsNameType, &ir); \ + Tcl_StoreInternalRep((objPtr), &nsNameType, &ir); \ } while (0) -#define NsNameGetInternalRep(objPtr, nnPtr) \ +#define NsNameGetInternalRep(objPtr, nnPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &nsNameType); \ - (nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &nsNameType); \ + (nnPtr) = irPtr ? (ResolvedNsName *) irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -181,6 +183,123 @@ static const EnsembleImplMap defaultNamespaceMap[] = { /* *---------------------------------------------------------------------- * + * CreateChildEntry -- + * + * Create a child namespace hash table entry. + * + * Results: + * Handle to hash table entry for a child namespace with the given name. + * Caller should handle filling in the namespace value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static inline Tcl_HashEntry * +CreateChildEntry( + Namespace *nsPtr, /* Parent namespace. */ + const char *name, /* Simple name to look for. */ + int *isNewPtr) /* Pointer to var with whether this is new. */ +{ +#ifndef BREAK_NAMESPACE_COMPAT + return Tcl_CreateHashEntry(&nsPtr->childTable, name, isNewPtr); +#else + if )nsPtr->childTablePtr == NULL) { + nsPtr->childTablePtr = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(nsPtr->childTablePtr, TCL_STRING_KEYS); + } + return Tcl_CreateHashEntry(nsPtr->childTablePtr, name, isNewPtr); +#endif +} + +/* + *---------------------------------------------------------------------- + * + * FindChildEntry -- + * + * Look up a child namespace hash table entry. + * + * Results: + * Handle to hash table entry if a child namespace with the given name + * exists, otherwise NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static inline Tcl_HashEntry * +FindChildEntry( + Namespace *nsPtr, /* Parent namespace. */ + const char *name) /* Simple name to look for. */ +{ +#ifndef BREAK_NAMESPACE_COMPAT + return Tcl_FindHashEntry(&nsPtr->childTable, name); +#else + return nsPtr->childTablePtr ? + Tcl_FindHashEntry(nsPtr->childTablePtr, name) : NULL; +#endif +} + +/* + *---------------------------------------------------------------------- + * + * FirstChildEntry -- + * + * Start an iteration through the collection of child namespaces. + * + * Results: + * Handle to hash table entry if a child namespace exists, otherwise NULL. + * + * Side effects: + * Updates the search handle. + * + *---------------------------------------------------------------------- + */ +static inline Tcl_HashEntry * +FirstChildEntry( + Namespace *nsPtr, /* Parent namespace. */ + Tcl_HashSearch *searchPtr) /* Iteration handle reference. */ +{ +#ifndef BREAK_NAMESPACE_COMPAT + return Tcl_FirstHashEntry(&nsPtr->childTable, searchPtr); +#else + return nsPtr->childTablePtr ? + Tcl_FirstHashEntry(nsPtr->childTablePtr, searchPtr) : NULL; +#endif +} + +/* + *---------------------------------------------------------------------- + * + * NumChildEntries -- + * + * Get the count of child namespaces. + * + * Results: + * Number of child entries. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static inline Tcl_Size +NumChildEntries( + Namespace *nsPtr) +{ +#ifndef BREAK_NAMESPACE_COMPAT + return nsPtr->childTable.numEntries; +#else + return nsPtr->childTablePtr ? nsPtr->childTablePtr->numEntries : 0; +#endif +} + +/* + *---------------------------------------------------------------------- + * * TclInitNamespaceSubsystem -- * * This function is called to initialize all the structures that are used @@ -221,7 +340,7 @@ TclInitNamespaceSubsystem(void) Tcl_Namespace * Tcl_GetCurrentNamespace( - Tcl_Interp *interp)/* Interpreter whose current namespace is + Tcl_Interp *interp) /* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); @@ -245,7 +364,7 @@ Tcl_GetCurrentNamespace( Tcl_Namespace * Tcl_GetGlobalNamespace( - Tcl_Interp *interp)/* Interpreter whose global namespace should + Tcl_Interp *interp) /* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); @@ -461,7 +580,7 @@ TclPushStackFrame( * treated as references to namespace * variables. */ { - *framePtrPtr = (Tcl_CallFrame *)TclStackAlloc(interp, sizeof(CallFrame)); + *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame)); return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr, isProcCallFrame); } @@ -653,7 +772,7 @@ Tcl_CreateNamespace( const char *name, /* Name for the new namespace. May be a * qualified name with names of ancestor * namespaces separated by "::"s. */ - void *clientData, /* One-word value to store with namespace. */ + void *clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no @@ -745,14 +864,7 @@ Tcl_CreateNamespace( * already exist in the parent namespace. */ - if ( -#ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL -#else - parentPtr->childTablePtr != NULL && - Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL -#endif - ) { + if (FindChildEntry(parentPtr, simpleName) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create namespace \"%s\": already exists", name)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", @@ -767,9 +879,9 @@ Tcl_CreateNamespace( */ doCreate: - nsPtr = (Namespace *)Tcl_Alloc(sizeof(Namespace)); + nsPtr = (Namespace *) Tcl_Alloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; - nsPtr->name = (char *)Tcl_Alloc(nameLen); + nsPtr->name = (char *) Tcl_Alloc(nameLen); memcpy(nsPtr->name, simpleName, nameLen); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; @@ -804,9 +916,7 @@ Tcl_CreateNamespace( nsPtr->earlyDeleteProc = NULL; if (parentPtr != NULL) { - entryPtr = Tcl_CreateHashEntry( - TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr), - simpleName, &newEntry); + entryPtr = CreateChildEntry(parentPtr, simpleName, &newEntry); Tcl_SetHashValue(entryPtr, nsPtr); } else { /* @@ -857,7 +967,7 @@ Tcl_CreateNamespace( name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); - nsPtr->fullName = (char *)Tcl_Alloc(nameLen + 1); + nsPtr->fullName = (char *) Tcl_Alloc(nameLen + 1); memcpy(nsPtr->fullName, name, nameLen + 1); Tcl_DStringFree(&buffer1); @@ -905,9 +1015,8 @@ Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { Namespace *nsPtr = (Namespace *) namespacePtr; - Interp *iPtr = (Interp *) nsPtr->interp; - Namespace *globalNsPtr = (Namespace *) - TclGetGlobalNamespace((Tcl_Interp *) iPtr); + Tcl_Interp *interp = nsPtr->interp; + Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr; @@ -949,10 +1058,9 @@ Tcl_DeleteNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); if (cmdPtr->nreProc == TclNRInterpCoroutine) { - Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, - (Tcl_Command) cmdPtr); + Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); } else { entryPtr = Tcl_NextHashEntry(&search); @@ -989,29 +1097,27 @@ Tcl_DeleteNamespace( } /* - * If the namespace is on the call frame stack, it is marked as "dying" - * (NS_DYING is OR'd into its flags): Contents of the namespace are - * still available and visible until the namespace is later marked as - * NS_DEAD, and its commands and variables are still usable by any - * active call frames referring to th namespace. When all active call - * frames referring to the namespace have been popped from the Tcl - * stack, Tcl_PopCallFrame calls Tcl_DeleteNamespace again. If no - * nsName objects refer to the namespace (i.e., if its refCount is - * zero), its commands and variables are deleted and the storage for - * its namespace structure is freed. Otherwise, if its refCount is - * nonzero, the namespace's commands and variables are deleted but the - * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's - * flags to allow the namespace resolution code to recognize that the - * namespace is "deleted". The structure's storage is freed by - * FreeNsNameInternalRep when its refCount reaches 0. + * If the namespace is on the call frame stack, it is marked as "dying" + * (NS_DYING is OR'd into its flags): Contents of the namespace are + * still available and visible until the namespace is later marked as + * NS_DEAD, and its commands and variables are still usable by any + * active call frames referring to th namespace. When all active call + * frames referring to the namespace have been popped from the Tcl + * stack, Tcl_PopCallFrame calls Tcl_DeleteNamespace again. If no + * nsName objects refer to the namespace (i.e., if its refCount is + * zero), its commands and variables are deleted and the storage for + * its namespace structure is freed. Otherwise, if its refCount is + * nonzero, the namespace's commands and variables are deleted but the + * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's + * flags to allow the namespace resolution code to recognize that the + * namespace is "deleted". The structure's storage is freed by + * FreeNsNameInternalRep when its refCount reaches 0. */ if (nsPtr->activationCount > (nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { - entryPtr = Tcl_FindHashEntry( - TclGetNamespaceChildTable((Tcl_Namespace *) - nsPtr->parentPtr), nsPtr->name); + entryPtr = FindChildEntry(nsPtr->parentPtr, nsPtr->name); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } @@ -1026,11 +1132,11 @@ Tcl_DeleteNamespace( * being deleted, ignore any second call. */ - nsPtr->flags |= (NS_DYING|NS_TEARDOWN); + nsPtr->flags |= NS_DYING | NS_TEARDOWN; TclTeardownNamespace(nsPtr); - if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) { + if ((nsPtr != globalNsPtr) || (((Interp *) interp)->flags & DELETED)) { /* * If this is the global namespace, then it may have residual * "errorInfo" and "errorCode" variables for errors that occurred @@ -1081,16 +1187,17 @@ void TclDeleteNamespaceChildren( Namespace *nsPtr) /* Namespace whose children to delete */ { - Interp *iPtr = (Interp *) nsPtr->interp; + Tcl_Interp *interp = nsPtr->interp; Tcl_HashEntry *entryPtr; size_t i; int unchecked; Tcl_HashSearch search; + /* * Delete all the child namespaces. * * BE CAREFUL: When each child is deleted, it divorces itself from its - * parent. The hash table can't be proplery traversed if its elements are + * parent. The hash table can't be properly traversed if its elements are * being deleted. Because of traces (and the desire to avoid the * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug * f97d4ee020]) copy to a temporary array and then delete all those @@ -1099,18 +1206,17 @@ TclDeleteNamespaceChildren( * Important: leave the hash table itself still live. */ -#ifndef BREAK_NAMESPACE_COMPAT - unchecked = (nsPtr->childTable.numEntries > 0); - while (nsPtr->childTable.numEntries > 0 && unchecked) { - size_t length = nsPtr->childTable.numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); + unchecked = (NumChildEntries(nsPtr) > 0); + while (NumChildEntries(nsPtr) > 0 && unchecked) { + size_t length = NumChildEntries(nsPtr); + Namespace **children = (Namespace **) + TclStackAlloc(interp, sizeof(Namespace *) * length); i = 0; - for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + for (entryPtr = FirstChildEntry(nsPtr, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); + children[i] = (Namespace *) Tcl_GetHashValue(entryPtr); children[i]->refCount++; i++; } @@ -1122,36 +1228,8 @@ TclDeleteNamespaceChildren( TclNsDecrRefCount(children[i]); } } - TclStackFree((Tcl_Interp *) iPtr, children); - } -#else - if (nsPtr->childTablePtr != NULL) { - unchecked = (nsPtr->childTable.numEntries > 0); - while (nsPtr->childTable.numEntries > 0 && unchecked) { - size_t length = nsPtr->childTablePtr->numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); - - i = 0; - for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); - children[i]->refCount++; - i++; - } - unchecked = 0; - for (i = 0 ; i < length ; i++) { - if (!(children[i]->flags & NS_DYING)) { - unchecked = 1; - Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); - TclNsDecrRefCount(children[i]); - } - } - TclStackFree((Tcl_Interp *) iPtr, children); - } + TclStackFree(interp, children); } -#endif } /* @@ -1178,10 +1256,10 @@ TclDeleteNamespaceChildren( void TclTeardownNamespace( - Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { - Interp *iPtr = (Interp *) nsPtr->interp; + Tcl_Interp *interp = nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Size i; @@ -1206,23 +1284,22 @@ TclTeardownNamespace( while (nsPtr->cmdTable.numEntries > 0) { Tcl_Size length = nsPtr->cmdTable.numEntries; - Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Command *) * length); + Command **cmds = (Command **) + TclStackAlloc(interp, sizeof(Command *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - cmds[i] = (Command *)Tcl_GetHashValue(entryPtr); + cmds[i] = (Command *) Tcl_GetHashValue(entryPtr); cmds[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { - Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, - (Tcl_Command) cmds[i]); + Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmds[i]); TclCleanupCommandMacro(cmds[i]); } - TclStackFree((Tcl_Interp *) iPtr, cmds); + TclStackFree(interp, cmds); } Tcl_DeleteHashTable(&nsPtr->cmdTable); Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); @@ -1232,9 +1309,7 @@ TclTeardownNamespace( */ if (nsPtr->parentPtr != NULL) { - entryPtr = Tcl_FindHashEntry( - TclGetNamespaceChildTable((Tcl_Namespace *) - nsPtr->parentPtr), nsPtr->name); + entryPtr = FindChildEntry(nsPtr->parentPtr, nsPtr->name); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } @@ -1316,7 +1391,7 @@ TclTeardownNamespace( static void NamespaceFree( - Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is @@ -1464,7 +1539,7 @@ Tcl_Export( if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; - nsPtr->exportArrayPtr = (char **)Tcl_Realloc(nsPtr->exportArrayPtr, + nsPtr->exportArrayPtr = (char **) Tcl_Realloc(nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } @@ -1473,7 +1548,7 @@ Tcl_Export( */ len = strlen(pattern); - patternCpy = (char *)Tcl_Alloc(len + 1); + patternCpy = (char *) Tcl_Alloc(len + 1); memcpy(patternCpy, pattern, len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; @@ -1514,7 +1589,8 @@ Tcl_Export( int Tcl_AppendExportList( - Tcl_Interp *interp, /* Interpreter used for error reporting. */ + Tcl_Interp *interp, /* Interpreter used for global NS and error + * reporting. */ Tcl_Namespace *namespacePtr,/* Points to the namespace whose export * pattern list is appended onto objPtr. NULL * for the current namespace. */ @@ -1615,7 +1691,7 @@ Tcl_Import( * want absence of the command to be a failure case. */ - if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) { + if (Tcl_FindCommand(interp, "auto_import", NULL, TCL_GLOBAL_ONLY) != NULL) { Tcl_Obj *objv[2]; int result; @@ -1685,7 +1761,7 @@ Tcl_Import( } for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { - char *cmdName = (char *)Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); + char *cmdName = (char *) Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern) && DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, @@ -1734,8 +1810,7 @@ DoImport( */ while (!exported && (i < importNsPtr->numExportPatterns)) { - exported |= Tcl_StringMatch(cmdName, - importNsPtr->exportArrayPtr[i++]); + exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]); } if (!exported) { return TCL_OK; @@ -1772,13 +1847,13 @@ DoImport( * namespace would create a cycle of imported command references. */ - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) { - Command *overwrite = (Command *)Tcl_GetHashValue(found); + Command *overwrite = (Command *) Tcl_GetHashValue(found); Command *linkCmd = cmdPtr; while (linkCmd->deleteProc == DeleteImportedCmd) { - dataPtr = (ImportedCmdData *)linkCmd->objClientData; + dataPtr = (ImportedCmdData *) linkCmd->objClientData; linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1792,7 +1867,7 @@ DoImport( } } - dataPtr = (ImportedCmdData *)Tcl_Alloc(sizeof(ImportedCmdData)); + dataPtr = (ImportedCmdData *) Tcl_Alloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); @@ -1808,15 +1883,16 @@ DoImport( * and add it to the import ref list in the "real" command. */ - refPtr = (ImportRef *)Tcl_Alloc(sizeof(ImportRef)); + refPtr = (ImportRef *) Tcl_Alloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; } else { - Command *overwrite = (Command *)Tcl_GetHashValue(found); + Command *overwrite = (Command *) Tcl_GetHashValue(found); if (overwrite->deleteProc == DeleteImportedCmd) { - ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData; + ImportedCmdData *dataPtr = (ImportedCmdData *) + overwrite->objClientData; if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) { /* @@ -1910,7 +1986,7 @@ Tcl_ForgetImport( if (TclMatchIsTrivial(simplePattern)) { hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (hPtr != NULL) { - Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); @@ -1920,12 +1996,12 @@ Tcl_ForgetImport( } for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc != DeleteImportedCmd) { continue; } - cmdName = (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); + cmdName = (char *) Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } @@ -1940,7 +2016,7 @@ Tcl_ForgetImport( for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Tcl_CmdInfo info; - Tcl_Command token = (Tcl_Command)Tcl_GetHashValue(hPtr); + Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr); Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { @@ -1953,7 +2029,8 @@ Tcl_ForgetImport( */ Command *cmdPtr = (Command *) token; - ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData; + ImportedCmdData *dataPtr = (ImportedCmdData *) + cmdPtr->objClientData; Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr; if (firstToken == origin) { @@ -1965,7 +2042,7 @@ Tcl_ForgetImport( } origin = firstToken; } - if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){ + if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) { Tcl_DeleteCommandFromToken(interp, token); } } @@ -2001,14 +2078,13 @@ TclGetOriginalCommand( * command should be returned. */ { Command *cmdPtr = (Command *) command; - ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { - dataPtr = (ImportedCmdData *)cmdPtr->objClientData; + ImportedCmdData *dataPtr = (ImportedCmdData *) cmdPtr->objClientData; cmdPtr = dataPtr->realCmdPtr; } return (Tcl_Command) cmdPtr; @@ -2035,13 +2111,13 @@ TclGetOriginalCommand( static int InvokeImportedNRCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; + ImportedCmdData *dataPtr = (ImportedCmdData *) clientData; Command *realCmdPtr = dataPtr->realCmdPtr; TclSkipTailcall(interp); @@ -2050,7 +2126,7 @@ InvokeImportedNRCmd( int TclInvokeImportedCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2083,10 +2159,10 @@ TclInvokeImportedCmd( static void DeleteImportedCmd( - void *clientData) /* Points to the imported command's + void *clientData) /* Points to the imported command's * ImportedCmdData structure. */ { - ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; + ImportedCmdData *dataPtr = (ImportedCmdData *) clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; ImportRef *refPtr, *prevPtr; @@ -2350,17 +2426,9 @@ TclGetNamespaceForQualName( */ if (nsPtr != NULL) { -#ifndef BREAK_NAMESPACE_COMPAT - entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName); -#else - if (nsPtr->childTablePtr == NULL) { - entryPtr = NULL; - } else { - entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName); - } -#endif + entryPtr = FindChildEntry(nsPtr, nsName); if (entryPtr != NULL) { - nsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); + nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame *framePtr; @@ -2389,17 +2457,9 @@ TclGetNamespaceForQualName( */ if (altNsPtr != NULL) { -#ifndef BREAK_NAMESPACE_COMPAT - entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName); -#else - if (altNsPtr->childTablePtr != NULL) { - entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName); - } else { - entryPtr = NULL; - } -#endif + entryPtr = FindChildEntry(altNsPtr, nsName); if (entryPtr != NULL) { - altNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); + altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); } else { /* Remember last found in alternate path */ lastAltNsPtr = altNsPtr; @@ -2522,7 +2582,7 @@ Tcl_FindNamespace( * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ - int flags) /* Flags controlling namespace lookup: an OR'd + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { @@ -2634,7 +2694,7 @@ Tcl_FindCommand( } if (result == TCL_OK) { - ((Command *)cmd)->flags |= CMD_VIA_RESOLVER; + ((Command *) cmd)->flags |= CMD_VIA_RESOLVER; return cmd; } else if (result != TCL_CONTINUE) { @@ -2660,7 +2720,7 @@ Tcl_FindCommand( || !(realNsPtr->flags & NS_DEAD)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } } @@ -2681,7 +2741,7 @@ Tcl_FindCommand( && !(realNsPtr->flags & NS_DEAD)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } } @@ -2699,7 +2759,7 @@ Tcl_FindCommand( && !(realNsPtr->flags & NS_DEAD)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } } @@ -2721,14 +2781,14 @@ Tcl_FindCommand( entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } } } if (cmdPtr != NULL) { - cmdPtr->flags &= ~CMD_VIA_RESOLVER; + cmdPtr->flags &= ~CMD_VIA_RESOLVER; return (Tcl_Command) cmdPtr; } @@ -2785,7 +2845,7 @@ TclResetShadowedCmdRefs( int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ - Namespace **trailPtr = (Namespace **)TclStackAlloc(interp, + Namespace **trailPtr = (Namespace **) TclStackAlloc(interp, trailSize * sizeof(Namespace *)); /* @@ -2805,7 +2865,8 @@ TclResetShadowedCmdRefs( * cmdName. */ - cmdName = (char *)Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr); + cmdName = (char *) + Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr); for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ; nsPtr=nsPtr->parentPtr) { /* @@ -2822,19 +2883,9 @@ TclResetShadowedCmdRefs( for (i = trailFront; i >= 0; i--) { trailNsPtr = trailPtr[i]; -#ifndef BREAK_NAMESPACE_COMPAT - hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable, - trailNsPtr->name); -#else - if (shadowNsPtr->childTablePtr != NULL) { - hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr, - trailNsPtr->name); - } else { - hPtr = NULL; - } -#endif + hPtr = FindChildEntry(shadowNsPtr, trailNsPtr->name); if (hPtr != NULL) { - shadowNsPtr = (Namespace *)Tcl_GetHashValue(hPtr); + shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr); } else { found = 0; break; @@ -2860,7 +2911,7 @@ TclResetShadowedCmdRefs( * for a fresh compilation of every bytecode. */ - if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL){ + if (((Command *) Tcl_GetHashValue(hPtr))->compileProc != NULL) { nsPtr->resolverEpoch++; } } @@ -2875,8 +2926,9 @@ TclResetShadowedCmdRefs( if (trailFront == trailSize) { int newSize = 2 * trailSize; - trailPtr = (Namespace **)TclStackRealloc(interp, trailPtr, - newSize * sizeof(Namespace *)); + trailPtr = (Namespace **) + TclStackRealloc(interp, trailPtr, + newSize * sizeof(Namespace *)); trailSize = newSize; } trailPtr[trailFront] = nsPtr; @@ -2957,8 +3009,8 @@ GetNamespaceFromObj( refNsPtr = resNamePtr->refNsPtr; if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) && (!refNsPtr || (refNsPtr == - (Namespace *)TclGetCurrentNamespace(interp)))) { - *nsPtrPtr = (Tcl_Namespace *)nsPtr; + (Namespace *) TclGetCurrentNamespace(interp)))) { + *nsPtrPtr = (Tcl_Namespace *) nsPtr; return TCL_OK; } Tcl_StoreInternalRep(objPtr, &nsNameType, NULL); @@ -2975,6 +3027,64 @@ GetNamespaceFromObj( /* *---------------------------------------------------------------------- * + * TclNewNamespaceObj -- + * + * Gets an object that contains a reference to a given namespace. + * + * Note that this gets the name of the namespace immediately; this means + * that the name is guaranteed to persist even if the namespace is + * deleted. (This is checked by test namespace-7.1.) + * + * Results: + * Returns a newly-allocated Tcl_Obj. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +Tcl_Obj * +TclNewNamespaceObj( + Tcl_Namespace *namespacePtr) +{ + Namespace *nsPtr = (Namespace *) namespacePtr; + Tcl_Size len; + Tcl_Obj *objPtr; + + /* + * If NS_DEAD set, we have no name any more; the fullName field may have + * been deallocated. + */ + assert(!(nsPtr->flags & NS_DEAD)); + + /* + * Need to get the name pro-actively; the name must persist after the + * namespace is deleted. This is the easiest way. + */ + + len = strlen(nsPtr->fullName); + TclNewStringObj(objPtr, nsPtr->fullName, len); + + /* + * But we know exactly which namespace this resolves to. Remember that + * unless things are already being taken apart. + */ + + if (!(nsPtr->flags & (NS_DYING | NS_TEARDOWN))) { + ResolvedNsName *resNamePtr = (ResolvedNsName *) + Tcl_Alloc(sizeof(ResolvedNsName)); + + resNamePtr->nsPtr = nsPtr; + resNamePtr->refNsPtr = NULL; + resNamePtr->refCount = 1; + NsNameSetInternalRep(objPtr, resNamePtr); + } + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * TclInitNamespaceCmd -- * * This function is called to create the "namespace" Tcl command. See the @@ -3031,7 +3141,7 @@ NamespaceChildrenCmd( Tcl_DString buffer; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - Tcl_Obj *listPtr, *elemPtr; + Tcl_Obj *listPtr; /* * Get a pointer to the specified namespace, or the current namespace. @@ -3040,7 +3150,7 @@ NamespaceChildrenCmd( if (objc == 1) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else if ((objc == 2) || (objc == 3)) { - if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){ + if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) { return TCL_ERROR; } nsPtr = (Namespace *) namespacePtr; @@ -3081,33 +3191,19 @@ NamespaceChildrenCmd( if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; } - if ( -#ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL -#else - nsPtr->childTablePtr != NULL && - Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL -#endif - ) { - Tcl_ListObjAppendElement(interp, listPtr, + if (FindChildEntry(nsPtr, pattern+length) != NULL) { + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(pattern, -1)); } goto searchDone; } -#ifndef BREAK_NAMESPACE_COMPAT - entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); -#else - if (nsPtr->childTablePtr == NULL) { - goto searchDone; - } - entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); -#endif + entryPtr = FirstChildEntry(nsPtr, &search); while (entryPtr != NULL) { - childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); + childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); if ((pattern == NULL) || Tcl_StringMatch(childNsPtr->fullName, pattern)) { - elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1); - Tcl_ListObjAppendElement(interp, listPtr, elemPtr); + Tcl_ListObjAppendElement(NULL, listPtr, + TclNewNamespaceObj((Tcl_Namespace *) childNsPtr)); } entryPtr = Tcl_NextHashEntry(&search); } @@ -3153,7 +3249,6 @@ NamespaceCodeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; Tcl_Size length; @@ -3188,19 +3283,14 @@ NamespaceCodeCmd( TclNewObj(listPtr); TclNewLiteralStringObj(objPtr, "::namespace"); - Tcl_ListObjAppendElement(interp, listPtr, objPtr); - TclNewLiteralStringObj(objPtr, "inscope"); - Tcl_ListObjAppendElement(interp, listPtr, objPtr); + Tcl_ListObjAppendElement(NULL, listPtr, objPtr); - currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { - TclNewLiteralStringObj(objPtr, "::"); - } else { - objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1); - } - Tcl_ListObjAppendElement(interp, listPtr, objPtr); + TclNewLiteralStringObj(objPtr, "inscope"); + Tcl_ListObjAppendElement(NULL, listPtr, objPtr); - Tcl_ListObjAppendElement(interp, listPtr, objv[1]); + Tcl_ListObjAppendElement(NULL, listPtr, + TclNewNamespaceObj(TclGetCurrentNamespace(interp))); + Tcl_ListObjAppendElement(NULL, listPtr, objv[1]); Tcl_SetObjResult(interp, listPtr); return TCL_OK; @@ -3234,8 +3324,6 @@ NamespaceCurrentCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Namespace *currNsPtr; - if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; @@ -3248,14 +3336,12 @@ NamespaceCurrentCmd( * easy to do things like: * * namespace [namespace current]::bar { ... } + * + * This behavior is encoded into TclNewNamespaceObj(). */ - currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2)); - } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1)); - } + Tcl_SetObjResult(interp, + TclNewNamespaceObj(TclGetCurrentNamespace(interp))); return TCL_OK; } @@ -3369,7 +3455,7 @@ NamespaceDeleteCmd( static int NamespaceEvalCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3466,13 +3552,13 @@ NsEval_Callback( Tcl_Interp *interp, int result) { - Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0]; + Tcl_Namespace *namespacePtr = (Tcl_Namespace *) data[0]; if (result == TCL_ERROR) { size_t length = strlen(namespacePtr->fullName); unsigned limit = 200; int overflow = (length > limit); - char *cmd = (char *)data[1]; + char *cmd = (char *) data[1]; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace %s \"%.*s%s\" script line %d)", @@ -3588,7 +3674,7 @@ NamespaceExportCmd( Tcl_Obj *listPtr; TclNewObj(listPtr); - (void)Tcl_AppendExportList(interp, NULL, listPtr); + (void) Tcl_AppendExportList(interp, NULL, listPtr); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -3754,11 +3840,11 @@ NamespaceImportCmd( TclNewObj(listPtr); for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( - (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); + (char *) Tcl_GetHashKey(&nsPtr->cmdTable, hPtr), -1)); } } Tcl_SetObjResult(interp, listPtr); @@ -3818,7 +3904,7 @@ NamespaceImportCmd( static int NamespaceInscopeCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3836,7 +3922,6 @@ NRNamespaceInscopeCmd( { Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; - int i; Tcl_Obj *cmdObjPtr; if (objc < 3) { @@ -3874,20 +3959,11 @@ NRNamespaceInscopeCmd( cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; - Tcl_Obj *listPtr; - - listPtr = Tcl_NewListObj(0, NULL); - for (i = 3; i < objc; i++) { - if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){ - Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ - return TCL_ERROR; - } - } concatObjv[0] = objv[2]; - concatObjv[1] = listPtr; + concatObjv[1] = Tcl_NewListObj(objc - 3, objv + 3); cmdObjPtr = Tcl_ConcatObj(2, concatObjv); - Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ + Tcl_DecrRefCount(concatObjv[1]); /* We're done with the list object. */ } TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", @@ -3949,17 +4025,19 @@ NamespaceOriginCmd( } TclNewObj(resultPtr); Tcl_GetCommandFullName(interp, origCmd, resultPtr); - if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) { + if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES) { Tcl_DecrRefCount(resultPtr); - namespaceOriginError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[1]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + goto namespaceOriginError; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; + + namespaceOriginError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid command name \"%s\"", TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -4008,8 +4086,7 @@ NamespaceParentCmd( */ if (nsPtr->parentPtr != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - nsPtr->parentPtr->fullName, -1)); + Tcl_SetObjResult(interp, TclNewNamespaceObj(nsPtr->parentPtr)); } return TCL_OK; } @@ -4069,8 +4146,8 @@ NamespacePathCmd( TclNewObj(resultObj); for (i=0 ; i<nsPtr->commandPathLength ; i++) { if (nsPtr->commandPathArray[i].nsPtr != NULL) { - Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( - nsPtr->commandPathArray[i].nsPtr->fullName, -1)); + Tcl_ListObjAppendElement(NULL, resultObj, TclNewNamespaceObj( + (Tcl_Namespace *) nsPtr->commandPathArray[i].nsPtr)); } } Tcl_SetObjResult(interp, resultObj); @@ -4085,8 +4162,8 @@ NamespacePathCmd( goto badNamespace; } if (nsObjc != 0) { - namespaceList = (Tcl_Namespace **)TclStackAlloc(interp, - sizeof(Tcl_Namespace *) * nsObjc); + namespaceList = (Tcl_Namespace **) + TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); for (i = 0; i < nsObjc; i++) { if (TclGetNamespaceFromObj(interp, nsObjv[i], @@ -4137,8 +4214,8 @@ TclSetNsPath( Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { if (pathLength != 0) { - NamespacePathEntry *tmpPathArray = - (NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength); + NamespacePathEntry *tmpPathArray = (NamespacePathEntry *) + Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength); Tcl_Size i; for (i=0 ; i<pathLength ; i++) { @@ -4733,7 +4810,7 @@ NamespaceWhichCmd( static void FreeNsNameInternalRep( - Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; @@ -4780,7 +4857,7 @@ FreeNsNameInternalRep( static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; @@ -4816,7 +4893,7 @@ SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; @@ -4841,12 +4918,12 @@ SetNsNameFromAny( */ nsPtr->refCount++; - resNamePtr = (ResolvedNsName *)Tcl_Alloc(sizeof(ResolvedNsName)); + resNamePtr = (ResolvedNsName *) Tcl_Alloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; } else { - resNamePtr->refNsPtr = (Namespace *)TclGetCurrentNamespace(interp); + resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } resNamePtr->refCount = 0; NsNameSetInternalRep(objPtr, resNamePtr); @@ -4901,7 +4978,8 @@ TclGetNamespaceChildTable( return &nPtr->childTable; #else if (nPtr->childTablePtr == NULL) { - nPtr->childTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + nPtr->childTablePtr = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS); } return nPtr->childTablePtr; @@ -4988,9 +5066,8 @@ TclLogCommandInfo( return; } else { - Tcl_HashEntry *hPtr - = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); - VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); + VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { /* diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index aa9d8dd..f5e89ca 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1130,8 +1130,8 @@ TclOOSelfObjCmd( Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr)); return TCL_OK; case SELF_NS: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - contextPtr->oPtr->namespacePtr->fullName, -1)); + Tcl_SetObjResult(interp, + TclNewNamespaceObj(contextPtr->oPtr->namespacePtr)); return TCL_OK; case SELF_CLASS: { Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 70f0381..0e5513a 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -1732,7 +1732,7 @@ TclOODefineDefnNsObjCmd( if (nsPtr == NULL) { return TCL_ERROR; } - nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1); + nsNamePtr = TclNewNamespaceObj(nsPtr); Tcl_IncrRefCount(nsNamePtr); } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 914ed38..77bb0b2 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -850,8 +850,7 @@ InfoObjectNsCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1)); + Tcl_SetObjResult(interp, TclNewNamespaceObj(oPtr->namespacePtr)); return TCL_OK; } |