Attachment "ns.patch" to
ticket [1686862fff]
added by
dgp
2007-03-23 22:05:28.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.300
diff -u -r1.300 tclInt.h
--- generic/tclInt.h 1 Dec 2006 15:55:45 -0000 1.300
+++ generic/tclInt.h 12 Feb 2007 13:36:08 -0000
@@ -2158,7 +2158,6 @@
MODULE_SCOPE Tcl_ObjType tclProcBodyType;
MODULE_SCOPE Tcl_ObjType tclStringType;
MODULE_SCOPE Tcl_ObjType tclArraySearchType;
-MODULE_SCOPE Tcl_ObjType tclNsNameType;
#ifndef NO_WIDE_TYPE
MODULE_SCOPE Tcl_ObjType tclWideIntType;
#endif
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.125
diff -u -r1.125 tclNamesp.c
--- generic/tclNamesp.c 8 Feb 2007 18:43:40 -0000 1.125
+++ generic/tclNamesp.c 12 Feb 2007 13:36:09 -0000
@@ -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
@@ -61,14 +62,12 @@
*/
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). */
+ 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
@@ -194,6 +193,8 @@
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,
@@ -237,7 +238,6 @@
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);
@@ -259,11 +259,11 @@
* the object.
*/
-Tcl_ObjType tclNsNameType = {
+static Tcl_ObjType nsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
- UpdateStringOfNsName, /* updateStringProc */
+ NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
@@ -414,6 +414,15 @@
nsPtr = (Namespace *) Tcl_GetCurrentNamespace(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*/
@@ -2425,7 +2434,7 @@
&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);
@@ -2446,7 +2455,7 @@
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);
@@ -2464,7 +2473,7 @@
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);
@@ -2816,77 +2825,49 @@
* namespace. */
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
- Interp *iPtr = (Interp *) interp;
- register ResolvedNsName *resNamePtr;
- register Namespace *nsPtr;
- Namespace *currNsPtr;
- CallFrame *savedFramePtr;
- int result = TCL_OK;
- char *name;
-
- /*
- * If the namespace name is fully qualified, do as if the lookup were done
- * from the global namespace; this helps avoid repeated lookups of fully
- * qualified names.
- */
-
- savedFramePtr = iPtr->varFramePtr;
- name = TclGetString(objPtr);
- if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = iPtr->rootFramePtr;
- }
-
- currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-
- /*
- * Get the internal representation, converting to a namespace type if
- * needed. The internal representation is a ResolvedNsName that points to
- * the actual namespace.
- */
-
- if (objPtr->typePtr != &tclNsNameType) {
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- goto done;
+ 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 {
+ /* 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;
}
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
-
- /*
- * Check the context namespace of the resolved symbol to make sure that it
- * is fresh. If not, then force another conversion to the namespace type,
- * to discard the old rep and create a new one. Note that we verify that
- * the namespace id of the cached namespace is the same as the id when we
- * cached it; this insures that the namespace wasn't deleted and a new one
- * created at the same address.
- */
+ 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;
- nsPtr = NULL;
- if ((resNamePtr != NULL) && (resNamePtr->refNsPtr == currNsPtr)
- && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+ if (objPtr->typePtr == &nsNameType) {
+ /* Check that the ResolvedNsName is still valid */
+ resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
+ if (!(nsPtr->flags & NS_DYING)
+ && ((resNamePtr->refNsPtr == NULL) || (resNamePtr->refNsPtr
+ == (Namespace *) Tcl_GetCurrentNamespace(interp)))) {
+ *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+ return TCL_OK;
}
}
- if (nsPtr == NULL) { /* Try again. */
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- goto done;
- }
+ if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
- if (resNamePtr != NULL) {
- nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
- }
- }
+ *nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
+ return TCL_OK;
}
- *nsPtrPtr = (Tcl_Namespace *) nsPtr;
-
- done:
- iPtr->varFramePtr = savedFramePtr;
- return result;
+ return TCL_ERROR;
}
/*
@@ -3074,12 +3055,6 @@
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?");
@@ -3414,16 +3389,13 @@
* 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);
@@ -3526,15 +3498,8 @@
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;
}
@@ -3867,11 +3832,6 @@
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.
@@ -4041,12 +4001,6 @@
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;
@@ -4146,11 +4100,6 @@
&namespaceList[i]) != TCL_OK) {
goto badNamespace;
}
- if (namespaceList[i] == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(nsObjv[i]), "\"", NULL);
- goto badNamespace;
- }
}
}
@@ -4648,14 +4597,6 @@
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;
@@ -4801,23 +4742,21 @@
* 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);
}
}
@@ -4849,10 +4788,8 @@
srcPtr->internalRep.otherValuePtr;
copyPtr->internalRep.otherValuePtr = (void *) resNamePtr;
- if (resNamePtr != NULL) {
- resNamePtr->refCount++;
- }
- copyPtr->typePtr = &tclNsNameType;
+ resNamePtr->refCount++;
+ copyPtr->typePtr = &nsNameType;
}
/*
@@ -4884,47 +4821,43 @@
* NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
- char *name;
const char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- name = objPtr->bytes;
- if (name == NULL) {
- 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.
- */
+ const char *name = TclGetString(objPtr);
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
- &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
/*
* If we found a namespace, then create a new ResolvedNsName structure
* that holds a reference to it.
*/
- if (nsPtr != NULL) {
- Namespace *currNsPtr = (Namespace *)
- Tcl_GetCurrentNamespace(interp);
+ if ((nsPtr != NULL) && !(nsPtr->flags & NS_DYING)) {
nsPtr->refCount++;
resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
resNamePtr->nsPtr = nsPtr;
- resNamePtr->nsId = nsPtr->nsId;
- resNamePtr->refNsPtr = currNsPtr;
+ if ((name[0] == ':') && (name[1] == ':')) {
+ resNamePtr->refNsPtr = NULL;
+ } else {
+ resNamePtr->refNsPtr =
+ (Namespace *) Tcl_GetCurrentNamespace(interp);
+ }
resNamePtr->refCount = 1;
} else {
- resNamePtr = NULL;
+ 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;
}
/*
@@ -4935,66 +4868,13 @@
TclFreeIntRep(objPtr);
objPtr->internalRep.otherValuePtr = (void *) resNamePtr;
- objPtr->typePtr = &tclNsNameType;
+ objPtr->typePtr = &nsNameType;
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);
- }
- }
-
- /*
- * 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* NamespaceEnsembleCmd --
*
* Invoked to implement the "namespace ensemble" command that creates and
@@ -5044,7 +4924,7 @@
int index;
nsPtr = (Namespace *) Tcl_GetCurrentNamespace(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);
@@ -6172,7 +6052,7 @@
}
restartEnsembleParse:
- if (ensemblePtr->nsPtr->flags & NS_DEAD) {
+ if (ensemblePtr->nsPtr->flags & NS_DYING) {
/*
* Don't know how we got here, but make things give up quickly.
*/
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.116
diff -u -r1.116 tclObj.c
--- generic/tclObj.c 1 Dec 2006 14:31:19 -0000 1.116
+++ generic/tclObj.c 12 Feb 2007 13:36:09 -0000
@@ -358,7 +358,6 @@
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclArraySearchType);
- Tcl_RegisterObjType(&tclNsNameType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.108
diff -u -r1.108 tclProc.c
--- generic/tclProc.c 28 Nov 2006 22:20:29 -0000 1.108
+++ generic/tclProc.c 12 Feb 2007 13:36:09 -0000
@@ -2396,14 +2396,6 @@
return result;
}
- if (nsPtr == NULL) {
- errPtr = Tcl_NewStringObj("cannot find namespace \"",-1);
- Tcl_AppendObjToObj(errPtr, nsObjPtr);
- Tcl_AppendToObj(errPtr, "\"", -1);
- Tcl_SetObjResult(interp, errPtr);
- return TCL_ERROR;
- }
-
cmd.nsPtr = (Namespace *) nsPtr;
isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
Index: tests/apply.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/apply.test,v
retrieving revision 1.9
diff -u -r1.9 apply.test
--- tests/apply.test 28 Oct 2006 22:48:43 -0000 1.9
+++ tests/apply.test 12 Feb 2007 13:36:10 -0000
@@ -15,7 +15,7 @@
# RCS: @(#) $Id: apply.test,v 1.9 2006/10/28 22:48:43 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.2
namespace import -force ::tcltest::*
}
@@ -79,32 +79,26 @@
# Tests for runtime errors in the lambda expression
-test apply-3.1 {non-existing namespace} {
- set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
- set res [catch {apply $lambda x} msg]
- list $res $msg
-} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-test apply-3.2 {non-existing namespace} {
+test apply-3.1 {non-existing namespace} -body {
+ apply [list x {set x 1} ::NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.2 {non-existing namespace} -body {
namespace eval ::NONEXIST::FOR::SURE {}
set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
apply $lambda x
namespace delete ::NONEXIST
- set res [catch {apply $lambda x} msg]
- list $res $msg
-} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-test apply-3.3 {non-existing namespace} {
- set lambda [list x {set x 1} NONEXIST::FOR::SURE]
- set res [catch {apply $lambda x} msg]
- list $res $msg
-} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-test apply-3.4 {non-existing namespace} {
+ apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.3 {non-existing namespace} -body {
+ apply [list x {set x 1} NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.4 {non-existing namespace} -body {
namespace eval ::NONEXIST::FOR::SURE {}
set lambda [list x {set x 1} NONEXIST::FOR::SURE]
apply $lambda x
namespace delete ::NONEXIST
- set res [catch {apply $lambda x} msg]
- list $res $msg
-} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
+ apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
test apply-4.1 {error in arguments to lambda expression} {
set lambda [list x {set x 1}]
Index: tests/namespace-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace-old.test,v
retrieving revision 1.11
diff -u -r1.11 namespace-old.test
--- tests/namespace-old.test 23 Nov 2006 15:35:31 -0000 1.11
+++ tests/namespace-old.test 12 Feb 2007 13:36:10 -0000
@@ -17,7 +17,7 @@
# RCS: @(#) $Id: namespace-old.test,v 1.11 2006/11/23 15:35:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.2
namespace import -force ::tcltest::*
}
@@ -336,9 +336,9 @@
list [catch {namespace children test_ns_hier1 y z} msg] $msg
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
-test namespace-old-5.10 {command "namespace children" must get valid namespace} {
- list [catch {namespace children xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace children command}}
+test namespace-old-5.10 {command "namespace children" must get valid namespace} -body {
+ namespace children xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
test namespace-old-5.11 {querying namespace children} {
lsort [namespace children :: test_ns_hier*]
@@ -372,9 +372,9 @@
list [catch {namespace parent x y} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}
-test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
- list [catch {namespace parent xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace parent command}}
+test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body {
+ namespace parent xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
test namespace-old-5.20 {querying namespace parent} {
list [namespace eval :: {namespace parent}] \
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.65
diff -u -r1.65 namespace.test
--- tests/namespace.test 8 Feb 2007 18:43:41 -0000 1.65
+++ tests/namespace.test 12 Feb 2007 13:36:10 -0000
@@ -229,7 +229,7 @@
[namespace children test_ns_1] \
[catch {namespace children test_ns_1::test_ns_2} msg] $msg \
[info commands test_ns_1::test_ns_2::test_ns_3a::*]
-} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
+} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}}
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
@@ -569,7 +569,7 @@
list [catch {set ::test_ns_777::v} msg] $msg \
[catch {namespace children test_ns_777} msg] $msg
}
-} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
+} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
namespace eval test_ns_1 {
list $v $test_ns_2::v
@@ -583,7 +583,7 @@
list [namespace children test_ns_2] \
[catch {namespace children test_ns_1} msg] $msg
}
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
namespace eval ::test_ns_2 {
namespace eval bar {}
@@ -601,7 +601,7 @@
list [namespace children test_ns_2] \
[catch {namespace children test_ns_1} msg] $msg
}
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
namespace children test_ns_1:::
} {::test_ns_1::test_ns_2}
@@ -864,11 +864,11 @@
namespace children test_ns_2
}
} {}
-test namespace-19.3 {GetNamespaceFromObj, name not found} {
+test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
namespace eval test_ns_1 {
- list [catch {namespace children test_ns_99} msg] $msg
+ namespace children test_ns_99
}
-} {1 {unknown namespace "test_ns_99" in namespace children command}}
+} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
namespace eval test_ns_1 {
proc foo {} {
@@ -1145,9 +1145,9 @@
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
list [catch {namespace inscope ::} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
-test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
- list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
-} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
+test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body {
+ namespace inscope test_ns_1 {set v}
+} -returnCodes error -result {namespace "test_ns_1" not found in "::"}
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
namespace eval test_ns_1 {
variable v 747
@@ -1217,9 +1217,9 @@
[namespace parent test_ns_1::test_ns_2] \
[namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
} {{} ::test_ns_1 ::test_ns_1}
-test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
- list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
-} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
+test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body {
+ namespace parent test_ns_1::test_ns_foo
+} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"}
test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -1365,11 +1365,11 @@
namespace children ::test_ns_1
}
} {::test_ns_1::test_ns_2}
-test namespace-37.2 {SetNsNameFromAny, ns name not found} {
+test namespace-37.2 {SetNsNameFromAny, ns name not found} -body {
namespace eval test_ns_1 {
- list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
+ namespace children ::test_ns_1::test_ns_foo
}
-} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
+} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found}
test namespace-38.1 {UpdateStringOfNsName} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -2317,7 +2317,7 @@
namespace eval ::test_ns_1 {
namespace path does::not::exist
}
-} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup {
+} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup {
catch {namespace delete ::test_ns_1}
}
test namespace-51.11 {name resolution path control} -body {
Index: tests/obj.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/obj.test,v
retrieving revision 1.19
diff -u -r1.19 obj.test
--- tests/obj.test 8 Oct 2005 14:42:54 -0000 1.19
+++ tests/obj.test 12 Feb 2007 13:36:10 -0000
@@ -31,7 +31,6 @@
cmdName
dict
end-offset
- nsName
regexp
string
} {
Index: tests/upvar.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/upvar.test,v
retrieving revision 1.14
diff -u -r1.14 upvar.test
--- tests/upvar.test 3 Nov 2006 00:34:53 -0000 1.14
+++ tests/upvar.test 12 Feb 2007 13:36:10 -0000
@@ -455,7 +455,7 @@
set w
}
} \
- -result {namespace "test_ns_0" does not exist} \
+ -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-returnCodes error \
-cleanup {namespace delete test_ns_1}
@@ -469,7 +469,7 @@
return [a]
}
} \
- -result {namespace "test_ns_0" does not exist} \
+ -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-returnCodes error \
-cleanup {namespace delete test_ns_1}
@@ -540,7 +540,7 @@
return [a]
}
} \
- -result {namespace "test_ns_0" does not exist} \
+ -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-returnCodes error \
-cleanup {namespace delete test_ns_1}