diff options
| -rw-r--r-- | generic/tclBasic.c | 8 | ||||
| -rw-r--r-- | generic/tclFileName.c | 2 | ||||
| -rw-r--r-- | generic/tclOO.c | 35 | ||||
| -rw-r--r-- | generic/tclOOCall.c | 8 | ||||
| -rw-r--r-- | generic/tclOOInt.h | 16 | ||||
| -rw-r--r-- | tests/oo.test | 12 |
6 files changed, 55 insertions, 26 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d4fa833..e6022ac 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3112,7 +3112,7 @@ Tcl_DeleteCommandFromToken( /* * We must delete this command, even though both traces and delete procs * may try to avoid this (renaming the command etc). Also traces and - * delete procs may try to delete the command themsevles. This flag + * delete procs may try to delete the command themselves. This flag * declares that a delete is in progress and that recursive deletes should * be ignored. */ @@ -7722,8 +7722,8 @@ ExprRandFunc( iPtr->flags |= RAND_SEED_INITIALIZED; /* - * Take into consideration the thread this interp is running in order - * to insure different seeds in different threads (bug #416643) + * To ensure different seeds in different threads (bug #416643), + * take into consideration the thread this interp is running in. */ iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); @@ -9091,7 +9091,7 @@ TclNRCoroutineObjCmd( TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); - /* insure that the command is looked up in the correct namespace */ + /* ensure that the command is looked up in the correct namespace */ iPtr->lookupNsPtr = lookupNsPtr; Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0); iPtr->numLevels--; diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 150fb8c..15fcde7 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1904,7 +1904,7 @@ TclGlob( } /* - * To process a [glob] invokation, this function may be called multiple + * To process a [glob] invocation, this function may be called multiple * times. Each time, the previously discovered filenames are in the * interpreter result. We stash that away here so the result is free for * error messsages. diff --git a/generic/tclOO.c b/generic/tclOO.c index 73acce8..e9ef2ce 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -880,7 +880,7 @@ ObjectRenamedTrace( * 2950259] */ - if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) { + if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) { Tcl_DeleteNamespace(oPtr->namespacePtr); } if (oPtr->classPtr) { @@ -1168,7 +1168,7 @@ ObjectNamespaceDeleted( Class *clsPtr = oPtr->classPtr, *mixinPtr; Method *mPtr; Tcl_Obj *filterObj, *variableObj; - int i; + int deleteAlreadyInProgress = 0, i; /* * Instruct everyone to no longer use any allocated fields of the object. @@ -1178,6 +1178,14 @@ ObjectNamespaceDeleted( */ if (oPtr->command) { + if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) { + /* + * Namespace deletion must have been triggered by a trace on command + * deletion , meaning that + */ + deleteAlreadyInProgress = 1; + } + Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); } if (oPtr->myCommand) { @@ -1273,14 +1281,17 @@ ObjectNamespaceDeleted( if (clsPtr->subclasses.list) { ckfree(clsPtr->subclasses.list); + clsPtr->subclasses.list = NULL; clsPtr->subclasses.num = 0; } if (clsPtr->instances.list) { ckfree(clsPtr->instances.list); + clsPtr->instances.list = NULL; clsPtr->instances.num = 0; } if (clsPtr->mixinSubs.list) { ckfree(clsPtr->mixinSubs.list); + clsPtr->mixinSubs.list = NULL; clsPtr->mixinSubs.num = 0; } @@ -1305,7 +1316,13 @@ ObjectNamespaceDeleted( * Delete the object structure itself. */ - DelRef(oPtr); + if (deleteAlreadyInProgress) { + oPtr->classPtr = NULL; + oPtr->namespacePtr = NULL; + } else { + DelRef(oPtr); + } + } /* @@ -2433,7 +2450,7 @@ Tcl_ObjectSetMetadata( * * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject -- * - * Main entry point for object invokations. The Public* and Private* + * Main entry point for object invocations. The Public* and Private* * wrapper functions (implementations of both object instance commands * and [my]) are just thin wrappers round the main TclOOObjectCmdCore * function. Note that the core is function is NRE-aware. @@ -2518,8 +2535,8 @@ TclOOInvokeObject( * * TclOOObjectCmdCore, FinalizeObjectCall -- * - * Main function for object invokations. Does call chain creation, - * management and invokation. The function FinalizeObjectCall exists to + * Main function for object invocations. Does call chain creation, + * management and invocation. The function FinalizeObjectCall exists to * clean up after the non-recursive processing of TclOOObjectCmdCore. * * ---------------------------------------------------------------------- @@ -2531,7 +2548,7 @@ TclOOObjectCmdCore( Tcl_Interp *interp, /* The interpreter containing the object. */ int objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ - int flags, /* Whether this is an invokation through the + int flags, /* Whether this is an invocation through the * public or the private command interface. */ Class *startCls) /* Where to start in the call chain, or NULL * if we are to start at the front with @@ -2720,7 +2737,7 @@ Tcl_ObjectContextInvokeNext( * call context while we process the body. However, need to adjust the * argument-skip control because we're guaranteed to have a single prefix * arg (i.e., 'next') and not the variable amount that can happen because - * method invokations (i.e., '$obj meth' and 'my meth'), constructors + * method invocations (i.e., '$obj meth' and 'my meth'), constructors * (i.e., '$cls new' and '$cls create obj') and destructors (no args at * all) come through the same code. */ @@ -2789,7 +2806,7 @@ TclNRObjectContextInvokeNext( * call context while we process the body. However, need to adjust the * argument-skip control because we're guaranteed to have a single prefix * arg (i.e., 'next') and not the variable amount that can happen because - * method invokations (i.e., '$obj meth' and 'my meth'), constructors + * method invocations (i.e., '$obj meth' and 'my meth'), constructors * (i.e., '$cls new' and '$cls create obj') and destructors (no args at * all) come through the same code. */ diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 3e4f561..d4e1e34 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -233,7 +233,7 @@ FreeMethodNameRep( * TclOOInvokeContext -- * * Invokes a single step along a method call-chain context. Note that the - * invokation of a step along the chain can cause further steps along the + * invocation of a step along the chain can cause further steps along the * chain to be invoked. Note that this function is written to be as light * in stack usage as possible. * @@ -830,7 +830,7 @@ AddMethodToCallChain( * Call chain semantics states that methods come as *late* in the * call chain as possible. This is done by copying down the * following methods. Note that this does not change the number of - * method invokations in the call chain; it just rearranges them. + * method invocations in the call chain; it just rearranges them. */ Class *declCls = callPtr->chain[i].filterDeclarer; @@ -935,7 +935,7 @@ IsStillValid( * TclOOGetCallContext -- * * Responsible for constructing the call context, an ordered list of all - * method implementations to be called as part of a method invokation. + * method implementations to be called as part of a method invocation. * This method is central to the whole operation of the OO system. * * ---------------------------------------------------------------------- @@ -1517,7 +1517,7 @@ TclOORenderCallChain( /* * Do the actual construction of the descriptions. They consist of a list * of triples that describe the details of how a method is understood. For - * each triple, the first word is the type of invokation ("method" is + * each triple, the first word is the type of invocation ("method" is * normal, "unknown" is special because it adds the method name as an * extra argument when handled by some method types, and "filter" is * special because it's a filter method). The second word is the name of diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 476446d..11ba698 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -149,8 +149,8 @@ typedef struct Object { struct Foundation *fPtr; /* The basis for the object system. Putting * this here allows the avoidance of quite a * lot of hash lookups on the critical path - * for object invokation and creation. */ - Tcl_Namespace *namespacePtr;/* This object's tame namespace. */ + * for object invocation and creation. */ + Tcl_Namespace *namespacePtr;/* This object's namespace. */ Tcl_Command command; /* Reference to this object's public * command. */ Tcl_Command myCommand; /* Reference to this object's internal @@ -162,12 +162,12 @@ typedef struct Object { /* Classes mixed into this object. */ LIST_STATIC(Tcl_Obj *) filters; /* List of filter names. */ - struct Class *classPtr; /* All classes have this non-NULL; it points - * to the class structure. Everything else has - * this NULL. */ + struct Class *classPtr; /* This is non-NULL for all classes, and NULL + * for everything else. It points to the class + * structure. */ int refCount; /* Number of strong references to this object. * Note that there may be many more weak - * references; this mechanism is there to + * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; int creationEpoch; /* Unique value to make comparisons of objects @@ -323,7 +323,7 @@ typedef struct Foundation { } Foundation; /* - * A call context structure is built when a method is called. They contain the + * A call context structure is built when a method is called. It contains the * chain of method implementations that are to be invoked by a particular * call, and the process of calling walks the chain, with the [next] command * proceeding to the next entry in the chain. @@ -334,7 +334,7 @@ typedef struct Foundation { struct MInvoke { Method *mPtr; /* Reference to the method implementation * record. */ - int isFilter; /* Whether this is a filter invokation. */ + int isFilter; /* Whether this is a filter invocation. */ Class *filterDeclarer; /* What class decided to add the filter; if * NULL, it was added by the object. */ }; diff --git a/tests/oo.test b/tests/oo.test index 54c4b75..6413094 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1482,6 +1482,18 @@ test oo-11.4 {OO: cleanup} { lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \ [oo::object create bar2] [bar2 destroy] } {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}} +test oo-11.5 {OO: cleanup} { + oo::class create obj1 + + trace add command obj1 delete {apply {{name1 name2 action} { + set namespace [info object namespace $name1] + namespace delete $namespace + }}} + + rename obj1 {} + # No segmentation fault + return done +} done test oo-12.1 {OO: filters} { oo::class create Aclass |