diff options
Diffstat (limited to 'generic/tclNamesp.c')
| -rw-r--r-- | generic/tclNamesp.c | 137 |
1 files changed, 47 insertions, 90 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 52dfcc3..cc3469d 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -9,7 +9,7 @@ * * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1997 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * Originally implemented by * Michael J. McLennan @@ -19,7 +19,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.8 1998/09/14 18:40:01 stanton Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.9 1999/02/03 00:55:05 stanton Exp $ */ #include "tclInt.h" @@ -298,11 +298,8 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame) } else { nsPtr = (Namespace *) namespacePtr; if (nsPtr->flags & NS_DEAD) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "namespace \"", - nsPtr->fullName, "\" not found in context \"", - Tcl_GetCurrentNamespace(interp)->fullName, "\"", - (char *) NULL); - return TCL_ERROR; + panic("Trying to push call frame for dead namespace"); + /*NOTREACHED*/ } } @@ -458,7 +455,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) char *simpleName; Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; - int newEntry, result; + int newEntry; /* * If there is no active namespace, the interpreter is being @@ -482,13 +479,9 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) * Find the parent for the new namespace. */ - result = TclGetNamespaceForQualName(interp, name, - (Namespace *) NULL, - /*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG), - &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); - if (result != TCL_OK) { - return NULL; - } + TclGetNamespaceForQualName(interp, name, (Namespace *) NULL, + /*flags*/ CREATE_NS_IF_UNKNOWN, &parentPtr, &dummy1Ptr, + &dummy2Ptr, &simpleName); /* * If the unqualified name at the end is empty, there were trailing @@ -926,7 +919,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst) Namespace *nsPtr, *exportNsPtr, *dummyPtr; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); char *simplePattern, *patternCpy; - int neededElems, len, i, result; + int neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. @@ -959,12 +952,9 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst) * Check that the pattern doesn't have namespace qualifiers. */ - result = TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &dummyPtr, - &dummyPtr, &simplePattern); - if (result != TCL_OK) { - return result; - } + TclGetNamespaceForQualName(interp, pattern, nsPtr, + /*flags*/ 0, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); + if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid export pattern \"", pattern, @@ -1174,12 +1164,9 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite) "empty import pattern", -1); return TCL_ERROR; } - result = TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr, - &dummyPtr, &simplePattern); - if (result != TCL_OK) { - return TCL_ERROR; - } + TclGetNamespaceForQualName(interp, pattern, nsPtr, + /*flags*/ 0, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); + if (importNsPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown namespace in import pattern \"", @@ -1322,7 +1309,6 @@ Tcl_ForgetImport(interp, namespacePtr, pattern) register Tcl_HashEntry *hPtr; Tcl_HashSearch search; Command *cmdPtr; - int result; /* * If the specified namespace is NULL, use the current namespace. @@ -1340,12 +1326,9 @@ Tcl_ForgetImport(interp, namespacePtr, pattern) * the end. */ - result = TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr, - &actualCtxPtr, &simplePattern); - if (result != TCL_OK) { - return result; - } + TclGetNamespaceForQualName(interp, pattern, nsPtr, + /*flags*/ 0, &importNsPtr, &dummyPtr, &actualCtxPtr, &simplePattern); + if (importNsPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown namespace in namespace forget pattern \"", @@ -1557,34 +1540,28 @@ DeleteImportedCmd(clientData) * final component is stored in *simpleNamePtr. * * Results: - * Ordinarily this procedure returns TCL_OK. It sets *nsPtrPtr and - * *altNsPtrPtr to point to the two possible namespaces which represent - * the last (containing) namespace in the qualified name. If the - * procedure sets either *nsPtrPtr or *altNsPtrPtr to NULL, then the - * search along that path failed. The procedure also stores a pointer - * to the simple name of the final component in *simpleNamePtr. If the - * qualified name is "::" or was treated as a namespace reference - * (FIND_ONLY_NS), the procedure stores a pointer to the - * namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets + * It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible + * namespaces which represent the last (containing) namespace in the + * qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr + * to NULL, then the search along that path failed. The procedure also + * stores a pointer to the simple name of the final component in + * *simpleNamePtr. If the qualified name is "::" or was treated as a + * namespace reference (FIND_ONLY_NS), the procedure stores a pointer + * to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets * *simpleNamePtr to point to an empty string. * - * If there is an error, this procedure returns TCL_ERROR. If "flags" - * contains TCL_LEAVE_ERR_MSG, an error message is returned in the - * interpreter's result object. Otherwise, the interpreter's result - * object is left unchanged. - * * *actualCxtPtrPtr is set to the actual context namespace. It is * set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr * is NULL, it is set to the current namespace context. * * Side effects: - * If flags contains TCL_LEAVE_ERR_MSG and an error is encountered, - * the interpreter's result object will contain an error message. + * If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be + * created. * *---------------------------------------------------------------------- */ -int +void TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr) Tcl_Interp *interp; /* Interpreter in which to find the @@ -1634,7 +1611,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, char *nsName; Tcl_HashEntry *entryPtr; Tcl_DString buffer; - int len, result; + int len; /* * Determine the context namespace nsPtr in which to start the primary @@ -1670,7 +1647,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, *altNsPtrPtr = NULL; *actualCxtPtrPtr = globalNsPtr; *simpleNamePtr = start; /* points to empty string */ - return TCL_OK; + return; } } *actualCxtPtrPtr = nsPtr; @@ -1729,7 +1706,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, *altNsPtrPtr = altNsPtr; *simpleNamePtr = start; Tcl_DStringFree(&buffer); - return TCL_OK; + return; } } else { /* @@ -1759,18 +1736,15 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, } else if (flags & CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame frame; - result = Tcl_PushCallFrame(interp, &frame, + (void) Tcl_PushCallFrame(interp, &frame, (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0); - if (result != TCL_OK) { - Tcl_DStringFree(&buffer); - return result; - } + nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName, (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL); Tcl_PopCallFrame(interp); + if (nsPtr == NULL) { - Tcl_DStringFree(&buffer); - return TCL_ERROR; + panic("Could not create namespace '%s'", nsName); } } else { /* namespace not found and wasn't created */ nsPtr = NULL; @@ -1799,7 +1773,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, *altNsPtrPtr = NULL; *simpleNamePtr = NULL; Tcl_DStringFree(&buffer); - return TCL_OK; + return; } start = end; @@ -1832,7 +1806,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; Tcl_DStringFree(&buffer); - return TCL_OK; + return; } /* @@ -1873,7 +1847,6 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags) { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; char *dummy; - int result; /* * Find the namespace(s) that contain the specified namespace name. @@ -1881,12 +1854,9 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags) * to its last component, a namespace. */ - result = TclGetNamespaceForQualName(interp, name, - (Namespace *) contextNsPtr, /*flags*/ (flags | FIND_ONLY_NS), - &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); - if (result != TCL_OK) { - return NULL; - } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, + (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + if (nsPtr != NULL) { return (Tcl_Namespace *) nsPtr; } else if (flags & TCL_LEAVE_ERR_MSG) { @@ -1997,12 +1967,8 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * Find the namespace(s) that contain the command. */ - result = TclGetNamespaceForQualName(interp, name, - (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], - &cxtNsPtr, &simpleName); - if (result != TCL_OK) { - return (Tcl_Command) NULL; - } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, + flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the command in the command table of its namespace. @@ -2131,12 +2097,8 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags) * Find the namespace(s) that contain the variable. */ - result = TclGetNamespaceForQualName(interp, name, - (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], - &cxtNsPtr, &simpleName); - if (result != TCL_OK) { - return (Tcl_Var) NULL; - } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, + flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the variable in the variable table of its namespace. @@ -3773,7 +3735,6 @@ SetNsNameFromAny(interp, objPtr) char *name, *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; register ResolvedNsName *resNamePtr; - int flags, result; /* * Get the string representation. Make it up-to-date if necessary. @@ -3791,12 +3752,8 @@ SetNsNameFromAny(interp, objPtr) * object with a NULL ResolvedNsName* internal rep. */ - flags = ((interp != NULL)? TCL_LEAVE_ERR_MSG : 0) | FIND_ONLY_NS; - result = TclGetNamespaceForQualName(interp, name, (Namespace *) NULL, - flags, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); - if (result != TCL_OK) { - return result; - } + TclGetNamespaceForQualName(interp, name, (Namespace *) NULL, + /*flags*/ FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); /* * If we found a namespace, then create a new ResolvedNsName structure |