Index: generic/xotcl.c =================================================================== diff -u -raa4211a6750a6d5d6907aa21d78a90629ec897dc -rd337d1f94a287b8d694b50c4b1000151de21098c --- generic/xotcl.c (.../xotcl.c) (revision aa4211a6750a6d5d6907aa21d78a90629ec897dc) +++ generic/xotcl.c (.../xotcl.c) (revision d337d1f94a287b8d694b50c4b1000151de21098c) @@ -1977,16 +1977,16 @@ static void PrimitiveDestroy(ClientData clientData); static void -NSDeleteChildren(Tcl_Interp *interp, Tcl_Namespace *ns) { - Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(ns); +NSDeleteChildren(Tcl_Interp *interp, Tcl_Namespace *nsPtr) { + Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(nsPtr); Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr; #ifdef OBJDELETION_TRACE - fprintf(stderr, "NSDeleteChildren %s\n", ns->fullName); + fprintf(stderr, "NSDeleteChildren %p %s\n", nsPtr, nsPtr->fullName); #endif - Tcl_ForgetImport(interp, ns, "*"); /* don't destroy namespace imported objects */ + Tcl_ForgetImport(interp, nsPtr, "*"); /* don't destroy namespace imported objects */ for (hPtr = Tcl_FirstHashEntry(cmdTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { @@ -1995,9 +1995,7 @@ if (!Tcl_Command_cmdEpoch(cmd)) { XOTclObject *object = XOTclGetObjectFromCmdPtr(cmd); - /*fprintf(stderr, "... check %s child key %s child object %p %p\n", - objectName(object),key,XOTclpGetObject(interp, key), - XOTclGetObjectFromCmdPtr(cmd));*/ + /*fprintf(stderr, "... check %p %s\n", object, object? objectName(object) : "(null)");*/ if (object) { /*fprintf(stderr, " ... child %s %p -- %s\n", oname, object, object?objectName(object):"(null)");*/ @@ -2058,6 +2056,7 @@ Tcl_HashEntry *hPtr; #ifdef OBJDELETION_TRACE + fprintf(stderr, "NSCleanupNamespace %p\n", ns); fprintf(stderr, "NSCleanupNamespace %p %.6x varTable %p\n", ns, ((Namespace *)ns)->flags, varTable); #endif /* @@ -2118,8 +2117,7 @@ int activationCount = 0; Tcl_CallFrame *f = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp); - /*fprintf(stderr, " ... correcting ActivationCount for %s was %d ", - nsPtr->fullName, ((Namespace *)nsPtr)->activationCount);*/ + /*fprintf(stderr, "XOTcl_DeleteNamespace %p ", nsPtr);*/ while (f) { if (f->nsPtr == nsPtr) @@ -2579,14 +2577,17 @@ static void CallStackDestroyObject(Tcl_Interp *interp, XOTclObject *object) { - /*fprintf(stderr, "CallStackDestroyObject %p %s activationcount %d flags %.6x\n", - object, objectName(object), object->activationCount, object->flags); */ +#ifdef OBJDELETION_TRACE + fprintf(stderr, "CallStackDestroyObject %p %s activationcount %d flags %.6x\n", + object, objectName(object), object->activationCount, object->flags); +#endif if ((object->flags & XOTCL_DESTROY_CALLED) == 0) { int activationCount = object->activationCount; /* if the destroy method was not called yet, do it now */ #ifdef OBJDELETION_TRACE - fprintf(stderr, " CallStackDestroyObject has to callDestroyMethod %p activationCount %d\n", object, activationCount); + fprintf(stderr, " CallStackDestroyObject has to callDestroyMethod %p activationCount %d\n", + object, activationCount); #endif callDestroyMethod(interp, object, 0); @@ -7563,7 +7564,8 @@ */ static void CleanupDestroyObject(Tcl_Interp *interp, XOTclObject *object, int softrecreate) { - /*fprintf(stderr, "CleanupDestroyObject obj %p softrecreate %d\n", object, softrecreate);*/ + /*fprintf(stderr, "CleanupDestroyObject obj %p softrecreate %d nsPtr %p\n", + object, softrecreate, object->nsPtr);*/ /* remove the instance, but not for ::Class/::Object */ if ((object->flags & XOTCL_IS_ROOT_CLASS) == 0 && @@ -7620,13 +7622,13 @@ */ static void CleanupInitObject(Tcl_Interp *interp, XOTclObject *object, - XOTclClass *cl, Tcl_Namespace *namespacePtr, int softrecreate) { + XOTclClass *cl, Tcl_Namespace *nsPtr, int softrecreate) { #ifdef OBJDELETION_TRACE fprintf(stderr, "+++ CleanupInitObject\n"); #endif object->teardown = interp; - object->nsPtr = namespacePtr; + object->nsPtr = nsPtr; if (!softrecreate) { AddInstance(object, cl); } @@ -7715,7 +7717,7 @@ object->teardown = NULL; if (object->nsPtr) { - /*fprintf(stderr, "primitive odestroy calls deleteNamespace for object %p nsPtr %p\n", object, object->nsPtr);*/ + /*fprintf(stderr, "PrimitiveODestroy calls deleteNamespace for object %p nsPtr %p\n", object, object->nsPtr);*/ XOTcl_DeleteNamespace(interp, object->nsPtr); object->nsPtr = NULL; } @@ -7741,6 +7743,7 @@ static void PrimitiveOInit(void *mem, Tcl_Interp *interp, CONST char *name, XOTclClass *cl) { XOTclObject *object = (XOTclObject*)mem; + Tcl_Namespace *nsPtr; #ifdef OBJDELETION_TRACE fprintf(stderr, "+++ PrimitiveOInit\n"); @@ -7752,11 +7755,19 @@ XOTclObjectRefCountIncr(object); MarkUndestroyed(object); - /* Tcl_Namespace *nsPtr = NULL; - nsPtr = NSGetFreshNamespace(interp, (ClientData)object, name, 0); - CleanupInitObject(interp, object, cl, nsPtr, 0);*/ - CleanupInitObject(interp, object, cl, NULL, 0); + /* + * There might be already a namespace with name name; if this is the + * case, use this namepsace as object namespace. The preexisting + * namespace might contain XOTcl objects. If we would not use the + * namespace as child namespace, we would not recognize the objects + * as child objects, deletions of the object might lead to a crash. + */ + nsPtr = Tcl_FindNamespace(interp, name, (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY); + /*fprintf(stderr, "PrimitiveOInit %p %s, ns %p\n", object, name, nsPtr); */ + + CleanupInitObject(interp, object, cl, nsPtr, 0); + /*obj->flags = XOTCL_MIXIN_ORDER_VALID | XOTCL_FILTER_ORDER_VALID;*/ object->mixinStack = NULL; object->filterStack = NULL; @@ -7885,7 +7896,7 @@ PRINTOBJ("CleanupDestroyClass", (XOTclObject *)cl); assert(softrecreate? recreate == 1 : 1); - /*fprintf(stderr, "CleanupDestroyClass softrecreate=%d, recreate=%d, %p\n", + /*fprintf(stderr, "CleanupDestroyClass %p softrecreate=%d, recreate=%d, %p\n", cl, softrecreate, recreate, clopt); */ /* do this even with no clopt, since the class might be used as a @@ -7931,8 +7942,7 @@ XOTclFreeObjectData(cl); #endif } - - Tcl_ForgetImport(interp, cl->nsPtr, "*"); /* don't destroy namespace imported objects */ + NSCleanupNamespace(interp, cl->nsPtr); NSDeleteChildren(interp, cl->nsPtr); @@ -8008,7 +8018,7 @@ * do class initialization & namespace creation */ static void -CleanupInitClass(Tcl_Interp *interp, XOTclClass *cl, Tcl_Namespace *namespacePtr, +CleanupInitClass(Tcl_Interp *interp, XOTclClass *cl, Tcl_Namespace *nsPtr, int softrecreate, int recreate) { XOTclClass *defaultSuperclass; @@ -8027,7 +8037,7 @@ */ XOTclObjectSetClass((XOTclObject*)cl); - cl->nsPtr = namespacePtr; + cl->nsPtr = nsPtr; if (!softrecreate) { /* subclasses are preserved during recreate, superclasses not (since Index: generic/xotclAccessInt.h =================================================================== diff -u -raa4211a6750a6d5d6907aa21d78a90629ec897dc -rd337d1f94a287b8d694b50c4b1000151de21098c --- generic/xotclAccessInt.h (.../xotclAccessInt.h) (revision aa4211a6750a6d5d6907aa21d78a90629ec897dc) +++ generic/xotclAccessInt.h (.../xotclAccessInt.h) (revision d337d1f94a287b8d694b50c4b1000151de21098c) @@ -75,7 +75,5 @@ XOTclGetObjectFromCmdPtr(Tcl_Command cmd) { return (XOTclObject*) XOTclGetClientDataFromCmdPtr(cmd); } -static XOTCLINLINE XOTclObject* -XOTclGetObjectFromCmdPtrNoAlias(Tcl_Command cmd) { - return Tcl_Command_objProc(cmd) == XOTclObjDispatch ? Tcl_Command_objClientData(cmd) : NULL; -} + + Index: tests/aliastest.xotcl =================================================================== diff -u -r2c0baf4a8ccba0820da0b4f318be18d2051e00ae -rd337d1f94a287b8d694b50c4b1000151de21098c --- tests/aliastest.xotcl (.../aliastest.xotcl) (revision 2c0baf4a8ccba0820da0b4f318be18d2051e00ae) +++ tests/aliastest.xotcl (.../aliastest.xotcl) (revision d337d1f94a287b8d694b50c4b1000151de21098c) @@ -379,5 +379,3 @@ ? {C info methods -methodtype alias} FOO ? {c FOO} ::c->foo2 ? {C info method definition FOO} "::C alias FOO ::foo"; # should be ::foo2 (!) - - Index: tests/destroytest.xotcl =================================================================== diff -u -rb3b84471d612c5883ec44ee884b6e03fd6574a32 -rd337d1f94a287b8d694b50c4b1000151de21098c --- tests/destroytest.xotcl (.../destroytest.xotcl) (revision b3b84471d612c5883ec44ee884b6e03fd6574a32) +++ tests/destroytest.xotcl (.../destroytest.xotcl) (revision d337d1f94a287b8d694b50c4b1000151de21098c) @@ -516,6 +516,59 @@ c1 destroy +# +# test cases where preexisting namespaces are re-used +# + +Test case module { + # create a namespace with an object/class in it + namespace eval ::module { Object create foo } + + # reuse the namespace for a class/object + Class create ::module + + ? {::xotcl::objectproperty ::module class} 1 + + # delete the object/class ... and namespace + ::module destroy + + ? {::xotcl::objectproperty ::module class} 0 +} + +Test case namespace-import { + + namespace eval ::module { + Class create Foo { + :create foo + } + namespace export Foo foo + } + Class create ::module { + :create mod1 + } + ? {xotcl::objectproperty ::module::Foo class} 1 + ? {xotcl::objectproperty ::module::foo class} 0 + ? {xotcl::objectproperty ::module::foo object} 1 + ? {xotcl::objectproperty ::module class} 1 + + Object create ::o { :requireNamespace } + namespace eval ::o {namespace import ::module::*} + + ? {xotcl::objectproperty ::o::Foo class} 1 + ? {xotcl::objectproperty ::o::foo object} 1 + + # do not destroy namespace imported objects/classes + ::o destroy + + ? {xotcl::objectproperty ::o::Foo class} 0 + ? {xotcl::objectproperty ::o::foo object} 0 + + ? {xotcl::objectproperty ::module::Foo class} 1 + ? {xotcl::objectproperty ::module::foo object} 1 + + ::module destroy +} + puts stderr "==== EXIT ====" exit