From cb0d0668227042f07802ebd4e713577cdf85a116 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 30 Oct 2017 05:19:55 +0000
Subject: [PATCH 0634/1800] Fix for issue 9fd5c629c1, TclOO - aborts when a
 trace on command deletion deletes the object's namespace.

---
 generic/tclBasic.c    |  8 ++++----
 generic/tclFileName.c |  2 +-
 generic/tclOO.c       | 35 ++++++++++++++++++++++++++---------
 generic/tclOOCall.c   |  8 ++++----
 generic/tclOOInt.h    | 16 ++++++++--------
 tests/oo.test         | 12 ++++++++++++
 6 files changed, 55 insertions(+), 26 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d4fa8330b..e6022ac6b 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 150fb8c4d..15fcde74a 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 73acce844..e9ef2ce29 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 3e4f561d2..d4e1e34d5 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 476446dbb..11ba698a3 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 2a6eb8003..6268dc6e0 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
-- 
2.19.1

