summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-02-03 00:55:04 (GMT)
committerstanton <stanton>1999-02-03 00:55:04 (GMT)
commite0ef1543276028c3f855c5e12b53551fc20fdebf (patch)
tree54aa9c12b6ea7911adec5a90deda722113ae9043 /generic/tclNamesp.c
parentd302d0e71085efc1f3c7d150e571cd9bb1901600 (diff)
downloadtcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.zip
tcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.tar.gz
tcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.tar.bz2
* generic/tclProc.c:
* generic/tclNamesp.c: * generic/tclInt.h: * generic/tclCmdIL.c: * generic/tclBasic.c: * generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize TCL_LEAVE_ERR_MSG behavior when creating variables. * generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug where upvar could resurrect a namespace variable whose namespace had been deleted. * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another bogus optimization in expression compilation. * generic/tclCompile.c (CompileExprWord): Fixed exception stack overflow bug caused by missing statement. [Bug: 928] * generic/tclIOCmd.c: * generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c137
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