Fix [Bug 1220058] and quash a bizarre case which generated a bogus error msg.

Thanks to Will Duquette for helping to track this one down.

4 files changed, 40 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index e4b8150..36b7688 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2005-06-14  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a
+	* tests/namespace.test (namespace-49.2): command from the hashtable on
+	reentrant processing if it has not been already deleted; at least
+	three deletes of the same command are possible. [Bug 1220058]
+	* generic/tclTrace.c (TraceCommandProc): Remove bogus error message
+	creation when traces trigger in situations where the command has
+	already been deleted.
+
 2005-06-13  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* generic/tclFCmd.c: correct fix to file mkdir 2005-06-09, [Bug 1219176]
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6935782..42f5465 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.160 2005/06/06 23:45:43 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.161 2005/06/14 13:46:02 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2504,11 +2504,16 @@ Tcl_DeleteCommandFromToken(interp, cmd)
 	/*
 	 * Another deletion is already in progress.  Remove the hash
 	 * table entry now, but don't invoke a callback or free the
-	 * command structure.
+	 * command structure. Take care to only remove the hash entry
+	 * if it has not already been removed; otherwise if we manage
+	 * to hit this function three times, everything goes up in
+	 * smoke. [Bug 1220058]
 	 */
 
-	Tcl_DeleteHashEntry(cmdPtr->hPtr);
-	cmdPtr->hPtr = NULL;
+	if (cmdPtr->hPtr != NULL) {
+	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	    cmdPtr->hPtr = NULL;
+	}
 	return 0;
     }
 
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 3a15ac8..d482a6b 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTrace.c,v 1.23 2005/05/10 18:34:51 kennykb Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.24 2005/06/14 13:46:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1284,6 +1284,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
      */
     if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
 	int untraceFlags = tcmdPtr->flags;
+	Tcl_InterpState state;
 
 	if (tcmdPtr->stepTrace != NULL) {
 	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
@@ -1315,9 +1316,14 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
 	 * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the
 	 * command we're tracing has just gone away.  Then decrement the
 	 * clientData refCount that was set up by trace creation.
+	 *
+	 * Note that we save the (return) state of the interpreter to
+	 * prevent bizarre error messages.
 	 */
+	state = Tcl_SaveInterpState(interp, TCL_OK);
 	Tcl_UntraceCommand(interp, oldName, untraceFlags,
 		TraceCommandProc, clientData);
+	(void) Tcl_RestoreInterpState(interp, state);
 	tcmdPtr->refCount--;
     }
     if ((--tcmdPtr->refCount) <= 0) {
diff --git a/tests/namespace.test b/tests/namespace.test
index c611e9c..1cae7d9 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.44 2005/05/30 00:04:49 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.45 2005/06/14 13:46:04 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1924,6 +1924,19 @@ test namespace-49.1 {ensemble subcommand caching} -body {
     rename c {}
     rename x {}
 }
+test namespace-49.2 {strange delete crash} -body {
+    namespace eval foo {namespace ensemble create -command ::bar}
+    trace add command ::bar delete DeleteTrace
+    proc DeleteTrace {old new op} {
+	trace remove command ::bar delete DeleteTrace
+	rename $old ""
+	# This next line caused a bus error in [Bug 1220058]
+	namespace delete foo
+    }
+    rename ::bar ""
+} -result "" -cleanup {
+    rename DeleteTrace ""
+}
 
 test namespace-50.1 {ensembles affect proc arguments error messages} -body {
     namespace ens cre -command a -map {b {bb foo}}