diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclBasic.c | 13 | ||||
| -rw-r--r-- | generic/tclTrace.c | 8 | ||||
| -rw-r--r-- | tests/namespace.test | 15 |
4 files changed, 40 insertions, 6 deletions
@@ -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}} |