From 179120bc16b5d9ec51d765d0b4c9deb94e32b77e Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 21 Jun 2005 14:44:55 +0000 Subject: * 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] --- ChangeLog | 9 ++++++++- generic/tclBasic.c | 16 +++++++++++++++- tests/trace.test | 19 ++++++++++++++++++- 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 +2005-06-21 Don Porter *** 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 + + * 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 {}} -- cgit v0.12