diff options
author | dgp <dgp@users.sourceforge.net> | 2007-09-09 19:28:30 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-09-09 19:28:30 (GMT) |
commit | 1aec3f216c9ebfc5dd9d7e8146dc452e9f76b7ae (patch) | |
tree | dc288f72c9331c09129c27b60b55930645fd7521 /generic/tclNamesp.c | |
parent | c751a324c1745d7c554ff34f1a85d4d18c2dfa86 (diff) | |
download | tcl-1aec3f216c9ebfc5dd9d7e8146dc452e9f76b7ae.zip tcl-1aec3f216c9ebfc5dd9d7e8146dc452e9f76b7ae.tar.gz tcl-1aec3f216c9ebfc5dd9d7e8146dc452e9f76b7ae.tar.bz2 |
* generic/tclInt.h: Removed the "nsName" Tcl_ObjType from the
* generic/tclNamesp.c: registered set. Revised the management of
* generic/tclObj.c: the intrep of that Tcl_ObjType. Revised the
* tests/obj.test: TclGetNamespaceFromObj() routine to return
TCL_ERROR and write a consistent error message when a namespace is
not found. [Bug 1588842. Patch 1686862]
***POTENTIAL INCOMPATIBILITY***
For callers of Tcl_GetObjType() on the name "nsName".
* generic/tclExecute.c: Update TclGetNamespaceFromObj() callers.
* generic/tclProc.c:
* tests/apply.test: Updated tests to expect new consistent
* tests/namespace-old.test: error message when a namespace is not
* tests/namespace.test: found.
* tests/upvar.test:
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 323 |
1 files changed, 106 insertions, 217 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d111f31..41b93d0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -13,6 +13,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2002-2005 Donal K. Fellows. * Copyright (c) 2006 Neil Madden. + * Contributions from Don Porter, NIST, 2007. (not subject to US copyright) * * Originally implemented by * Michael J. McLennan @@ -22,7 +23,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.148 2007/08/03 13:51:40 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.149 2007/09/09 19:28:31 dgp Exp $ */ #include "tclInt.h" @@ -54,15 +55,12 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct ResolvedNsName { - Namespace *nsPtr; /* A cached namespace pointer. */ - long nsId; /* nsPtr's unique namespace id. Used to verify - * that nsPtr is still valid (e.g., it's - * possible that the namespace was deleted and - * a new one created at the same address). */ - Namespace *refNsPtr; /* Points to the namespace containing the - * reference (not the namespace that contains - * the referenced namespace). NULL if the name - * is fully qualified.*/ + Namespace *nsPtr; /* A cached pointer to the Namespace that the + * name resolved to. */ + Namespace *refNsPtr; /* Points to the namespace context in which + * the name was resolved. NULL if the name + * is fully qualified and thus the resolution + * does not depend on the context. */ int refCount; /* Reference count: 1 for each nsName object * that has a pointer to this ResolvedNsName * structure as its internal rep. This @@ -167,6 +165,8 @@ static char * EstablishErrorInfoTraces(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void FreeNsNameInternalRep(Tcl_Obj *objPtr); +static int GetNamespaceFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceChildrenCmd(ClientData dummy, @@ -210,7 +210,6 @@ static int NamespaceUnknownCmd(ClientData dummy, static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfNsName(Tcl_Obj *objPtr); static int NsEnsembleImplementationCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr); @@ -232,11 +231,11 @@ static void UnlinkNsPath(Namespace *nsPtr); * the object. */ -Tcl_ObjType tclNsNameType = { +static Tcl_ObjType nsNameType = { "nsName", /* the type's name */ FreeNsNameInternalRep, /* freeIntRepProc */ DupNsNameInternalRep, /* dupIntRepProc */ - UpdateStringOfNsName, /* updateStringProc */ + NULL, /* updateStringProc */ SetNsNameFromAny /* setFromAnyProc */ }; @@ -381,6 +380,15 @@ Tcl_PushCallFrame( nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; + /* + * TODO: Examine whether it would be better to guard based + * on NS_DYING or NS_KILLED. It appears that these are not + * tested because they can be set in a global interp that + * has been [namespace delete]d, but which never really + * completely goes away because of lingering global things + * like ::errorInfo and [::unknown] and hidden commands. + * Review of those designs might permit stricter checking here. + */ if (nsPtr->flags & NS_DEAD) { Tcl_Panic("Trying to push call frame for dead namespace"); /*NOTREACHED*/ @@ -2411,7 +2419,7 @@ Tcl_FindCommand( &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL)) { if ((cxtNsPtr == realNsPtr) - || !(realNsPtr->flags & (NS_DEAD|NS_DYING))) { + || !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); @@ -2432,7 +2440,7 @@ Tcl_FindCommand( TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) - && !(realNsPtr->flags & (NS_DEAD|NS_DYING))) { + && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); @@ -2450,7 +2458,7 @@ Tcl_FindCommand( TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) - && !(realNsPtr->flags & (NS_DEAD|NS_DYING))) { + && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); @@ -2636,18 +2644,15 @@ TclResetShadowedCmdRefs( * Results: * Returns TCL_OK if the namespace was resolved successfully, and stores * a pointer to the namespace in the location specified by nsPtrPtr. If - * the namespace can't be found, the function stores NULL in *nsPtrPtr - * and returns TCL_OK. If anything else goes wrong, this function returns - * TCL_ERROR. + * the namespace can't be found, or anything else goes wrong, this + * function returns TCL_ERROR and writes an error message to interp, + * if non-NULL. * * Side effects: * May update the internal representation for the object, caching the * namespace reference. The next time this function is called, the * namespace value can be found quickly. * - * If anything goes wrong, an error message is left in the interpreter's - * result object. - * *---------------------------------------------------------------------- */ @@ -2658,50 +2663,49 @@ TclGetNamespaceFromObj( * namespace. */ Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { - ResolvedNsName *resPtr; - Namespace *nsPtr; - int result = TCL_OK; - - /* - * Get the internal representation, converting to a namespace type if - * needed. The internal representation is a ResolvedNsName that points to - * the actual namespace. - * - * Check the context namespace of the resolved symbol to make sure that it - * is fresh. Note that we verify that the namespace id of the context - * namespace is the same as the one we cached; this insures that the - * namespace wasn't deleted and a new one created at the same address. - * Note that fully qualified names have a NULL refNsPtr, these checks - * needn't be made. - * - * If any check fails, then force another conversion to the command type, - * to discard the old rep and create a new one. - */ - - resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; - if ((objPtr->typePtr != &tclNsNameType) - || (resPtr == NULL) - || (resPtr->refNsPtr && - (resPtr->refNsPtr != (Namespace *) TclGetCurrentNamespace(interp))) - || (nsPtr = resPtr->nsPtr, nsPtr->flags & NS_DEAD) - || (interp != nsPtr->interp) - || (resPtr->nsId != nsPtr->nsId)) { - - result = tclNsNameType.setFromAnyProc(interp, objPtr); - - resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; - if ((result == TCL_OK) && resPtr) { - nsPtr = resPtr->nsPtr; - if (nsPtr && (nsPtr->flags & NS_DEAD)) { - nsPtr = NULL; - } + if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) { + const char *name = Tcl_GetString(objPtr); + if ((name[0] == ':') && (name[1] == ':')) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "namespace \"%s\" not found", name)); } else { - nsPtr = NULL; + /* Get the current namespace name */ + NamespaceCurrentCmd(NULL, interp, 2, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "namespace \"%s\" not found in \"%s\"", name, + Tcl_GetStringResult(interp))); } + return TCL_ERROR; } + return TCL_OK; +} +static int +GetNamespaceFromObj( + Tcl_Interp *interp, /* The current interpreter. */ + Tcl_Obj *objPtr, /* The object to be resolved as the name of a + * namespace. */ + Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ +{ + ResolvedNsName *resNamePtr; + Namespace *nsPtr; - *nsPtrPtr = (Tcl_Namespace *) nsPtr; - return result; + if (objPtr->typePtr == &nsNameType) { + /* Check that the ResolvedNsName is still valid. */ + resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; + nsPtr = resNamePtr->nsPtr; + if (!(nsPtr->flags & NS_DYING) + && ((resNamePtr->refNsPtr == NULL) || (resNamePtr->refNsPtr + == (Namespace *) Tcl_GetCurrentNamespace(interp)))) { + *nsPtrPtr = (Tcl_Namespace *) nsPtr; + return TCL_OK; + } + } + if (SetNsNameFromAny(interp, objPtr) == TCL_OK) { + resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; + *nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr; + return TCL_OK; + } + return TCL_ERROR; } /* @@ -2889,12 +2893,6 @@ NamespaceChildrenCmd( if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) { return TCL_ERROR; } - if (namespacePtr == NULL) { - Tcl_AppendResult(interp, "unknown namespace \"", - TclGetString(objv[2]), - "\" in namespace children command", NULL); - return TCL_ERROR; - } nsPtr = (Namespace *) namespacePtr; } else { Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?"); @@ -3229,16 +3227,13 @@ NamespaceEvalCmd( * namespace object along the way. */ - result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr); - if (result != TCL_OK) { - return result; - } + result = GetNamespaceFromObj(interp, objv[2], &namespacePtr); /* * If the namespace wasn't found, try to create it. */ - if (namespacePtr == NULL) { + if (result == TCL_ERROR) { char *name = TclGetString(objv[2]); namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, NULL); @@ -3341,15 +3336,8 @@ NamespaceExistsCmd( return TCL_ERROR; } - /* - * Check whether the given namespace exists - */ - - if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) { - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(namespacePtr != NULL)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK)); return TCL_OK; } @@ -3682,11 +3670,6 @@ NamespaceInscopeCmd( if (result != TCL_OK) { return result; } - if (namespacePtr == NULL) { - Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[2]), - "\" in inscope namespace command", NULL); - return TCL_ERROR; - } /* * Make the specified namespace the current namespace. @@ -3856,12 +3839,6 @@ NamespaceParentCmd( if (result != TCL_OK) { return result; } - if (nsPtr == NULL) { - Tcl_AppendResult(interp, "unknown namespace \"", - TclGetString(objv[2]), - "\" in namespace parent command", NULL); - return TCL_ERROR; - } } else { Tcl_WrongNumArgs(interp, 2, objv, "?name?"); return TCL_ERROR; @@ -3957,11 +3934,6 @@ NamespacePathCmd( &namespaceList[i]) != TCL_OK) { goto badNamespace; } - if (namespaceList[i] == NULL) { - Tcl_AppendResult(interp, "unknown namespace \"", - TclGetString(nsObjv[i]), "\"", NULL); - goto badNamespace; - } } } @@ -4459,14 +4431,6 @@ NamespaceUpvarCmd( if (result != TCL_OK) { return TCL_ERROR; } - if (nsPtr == NULL) { - /* - * The namespace does not exist, leave an error message. - */ - Tcl_SetObjResult(interp, Tcl_Format(NULL, - "namespace \"%s\" does not exist", 1, objv+2)); - return TCL_ERROR; - } objc -= 3; objv += 3; @@ -4612,23 +4576,21 @@ FreeNsNameInternalRep( * references, free it up. */ - if (resNamePtr != NULL) { - resNamePtr->refCount--; - if (resNamePtr->refCount == 0) { + resNamePtr->refCount--; + if (resNamePtr->refCount == 0) { - /* - * Decrement the reference count for the cached namespace. If the - * namespace is dead, and there are no more references to it, free - * it. - */ + /* + * Decrement the reference count for the cached namespace. If the + * namespace is dead, and there are no more references to it, free + * it. + */ - nsPtr = resNamePtr->nsPtr; - nsPtr->refCount--; - if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { - NamespaceFree(nsPtr); - } - ckfree((char *) resNamePtr); + nsPtr = resNamePtr->nsPtr; + nsPtr->refCount--; + if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { + NamespaceFree(nsPtr); } + ckfree((char *) resNamePtr); } } @@ -4660,10 +4622,8 @@ DupNsNameInternalRep( srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; - if (resNamePtr != NULL) { - resNamePtr->refCount++; - } - copyPtr->typePtr = &tclNsNameType; + resNamePtr->refCount++; + copyPtr->typePtr = &nsNameType; } /* @@ -4695,118 +4655,47 @@ SetNsNameFromAny( * NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - char *name; const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; register ResolvedNsName *resNamePtr; + const char *name = TclGetString(objPtr); - /* - * Look for the namespace "name" in the current namespace. If there is an - * error parsing the (possibly qualified) name, return an error. If the - * namespace isn't found, we convert the object to an nsName object with a - * NULL ResolvedNsName* internal rep. - */ - - name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); /* * If we found a namespace, then create a new ResolvedNsName structure * that holds a reference to it. - * - * Free the old internalRep before setting the new one. Do this after - * getting the string rep to allow the conversion code (in particular, - * Tcl_GetStringFromObj) to use that old internalRep. */ - if (nsPtr) { + if ((nsPtr != NULL) && !(nsPtr->flags & NS_DYING)) { nsPtr->refCount++; - resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; - if ((objPtr->typePtr == &tclNsNameType) - && resNamePtr && (resNamePtr->refCount == 1)) { - /* - * Reuse the old ResolvedNsName struct instead of freeing it - */ - - Namespace *oldNsPtr = resNamePtr->nsPtr; - if ((--oldNsPtr->refCount == 0) && (oldNsPtr->flags & NS_DEAD)) { - NamespaceFree(oldNsPtr); - } - } else { - TclFreeIntRep(objPtr); - resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); - resNamePtr->refCount = 1; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; - objPtr->typePtr = &tclNsNameType; - } + resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; - resNamePtr->nsId = nsPtr->nsId; - if ((*name++ == ':') && (*name == ':')) { + if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; } else { resNamePtr->refNsPtr = - (Namespace *) TclGetCurrentNamespace(interp); + (Namespace *) Tcl_GetCurrentNamespace(interp); } - } else { + resNamePtr->refCount = 1; TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) NULL; - objPtr->typePtr = &tclNsNameType; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * UpdateStringOfNsName -- - * - * Updates the string representation for a nsName object. Note: This - * function does not free an existing old string rep so storage will be - * lost if this has not already been done. - * - * Results: - * None. - * - * Side effects: - * The object's string is set to a copy of the fully qualified namespace - * name. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfNsName( - register Tcl_Obj *objPtr) /* nsName object with string rep to update. */ -{ - ResolvedNsName *resNamePtr = - (ResolvedNsName *) objPtr->internalRep.otherValuePtr; - char *name = ""; - int length = 0; - - if ((resNamePtr != NULL) - && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) { - register Namespace *nsPtr = resNamePtr->nsPtr; - - if (nsPtr != NULL && !(nsPtr->flags & NS_DEAD)) { - name = nsPtr->fullName; - length = strlen(name); + objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; + objPtr->typePtr = &nsNameType; + return TCL_OK; + } else { + if (objPtr->typePtr == &nsNameType) { + /* + * Our failed lookup proves any previously cached nsName + * intrep is no longer valid. Get rid of it so we no longer + * waste memory storing it, nor time determining its invalidity + * again and again. + */ + TclFreeIntRep(objPtr); + objPtr->typePtr = NULL; } + return TCL_ERROR; } - - /* - * The following sets the string rep to an empty string on the heap if the - * internal rep is NULL. - */ - - if (length == 0) { - objPtr->bytes = tclEmptyStringRep; - } else { - objPtr->bytes = (char *) ckalloc((unsigned) (length + 1)); - memcpy(objPtr->bytes, name, (unsigned) length); - objPtr->bytes[length] = '\0'; - } - objPtr->length = length; } /* @@ -4861,7 +4750,7 @@ NamespaceEnsembleCmd( int index; nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - if (nsPtr == NULL || nsPtr->flags & NS_DEAD) { + if (nsPtr == NULL || nsPtr->flags & NS_DYING) { if (!Tcl_InterpDeleted(interp)) { Tcl_AppendResult(interp, "tried to manipulate ensemble of deleted namespace", NULL); @@ -5989,7 +5878,7 @@ NsEnsembleImplementationCmd( } restartEnsembleParse: - if (!(ensemblePtr->nsPtr->flags & NS_DEAD)) { + if (!(ensemblePtr->nsPtr->flags & NS_DYING)) { if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { /* * Table of subcommands is still valid; therefore there might be a |