* generic/tclBasic.c (Tcl_DeleteTrace): Added missing walk of the

        * tests/trace.test (trace-34.1):        list of active traces to
        cleanup references to traces being deleted. [Bug 1201035]

3 files changed, 41 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index 6d140a7..1907a0b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,14 @@
-2005-06-20  Don Porter  <dgp@users.sourceforge.net>
+2005-06-21  Don Porter  <dgp@users.sourceforge.net>
 
 	*** 8.4.11 TAGGED FOR RELEASE ***
 
+	* generic/tclBasic.c (Tcl_DeleteTrace):	Added missing walk of the
+	* tests/trace.test (trace-34.1):	list of active traces to
+	cleanup references to traces being deleted. [Bug 1201035]
+
+2005-06-20  Don Porter  <dgp@users.sourceforge.net>
+
+
 	* doc/FileSystem.3: added missing Tcl_GlobTypeData documentation
 	[Bug 935853]
 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index dfa24e8..ccb6de9 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.75.2.14 2005/03/18 16:33:41 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.15 2005/06/21 14:44:58 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -5160,6 +5160,7 @@ Tcl_DeleteTrace(interp, trace)
     Interp *iPtr = (Interp *) interp;
     Trace *tracePtr = (Trace *) trace;
     register Trace **tracePtr2 = &(iPtr->tracePtr);
+    ActiveInterpTrace *activePtr;
 
     /*
      * Locate the trace entry in the interpreter's trace list,
@@ -5175,6 +5176,19 @@ Tcl_DeleteTrace(interp, trace)
     (*tracePtr2) = (*tracePtr2)->nextPtr;
 
     /*
+     * The code below makes it possible to delete traces while traces
+     * are active: it makes sure that the deleted trace won't be
+     * processed by TclCheckInterpTraces.
+     */
+
+    for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	}
+    }
+
+    /*
      * If the trace forbids bytecode compilation, change the interpreter's
      * state.  If bytecode compilation is now permitted, flag the fact and
      * advance the compilation epoch so that procs will be recompiled to
diff --git a/tests/trace.test b/tests/trace.test
index 322f761..4456afa 100644
--- a/tests/trace.test
+++ b/tests/trace.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: trace.test,v 1.26.2.4 2004/11/15 21:14:34 dgp Exp $
+# RCS: @(#) $Id: trace.test,v 1.26.2.5 2005/06/21 14:44:59 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2139,6 +2139,23 @@ test trace-33.1 {variable match with remove variable} {
     llength [trace info variable x]
 } 0
 
+test trace-34.1 {Bug 1201035} {
+    set ::x [list]
+    proc foo {} {lappend ::x foo}
+    proc bar args {
+	lappend ::x $args
+	trace remove execution foo leavestep bar
+	trace remove execution foo enterstep bar
+	trace add execution foo leavestep bar
+	trace add execution foo enterstep bar
+	lappend ::x done
+    }
+    trace add execution foo leavestep bar
+    trace add execution foo enterstep bar
+    foo
+    set ::x
+} {{{lappend ::x foo} enterstep} done foo}
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}