diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclBasic.c | 3 | ||||
| -rw-r--r-- | generic/tclInt.h | 6 | ||||
| -rw-r--r-- | generic/tclTrace.c | 42 | ||||
| -rw-r--r-- | tests/trace.test | 37 |
5 files changed, 87 insertions, 9 deletions
@@ -1,3 +1,11 @@ +2005-06-21 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Added missing walk of the list of active traces + * generic/tclTrace.c: to cleanup references to traces being deleted. + * generic/tclInt.h: [Bug 1201035] Made the walk of the active trace + * tests/trace.test (trace-34.*): list aware of the direction of trace + scanning, so the proper correction can be made. [Bug 1224585] + 2005-06-21 Donal K. Fellows <dkf@users.sf.net> * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 42f5465..0d9cdec 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.161 2005/06/14 13:46:02 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.162 2005/06/21 18:33:02 dgp Exp $ */ #include "tclInt.h" @@ -2683,6 +2683,7 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) result = NULL; active.nextPtr = iPtr->activeCmdTracePtr; + active.reverseScan = 0; iPtr->activeCmdTracePtr = &active; if (flags & TCL_TRACE_DELETE) { diff --git a/generic/tclInt.h b/generic/tclInt.h index db8591b..aaef1a9 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.236 2005/06/18 21:45:02 das Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.237 2005/06/21 18:33:04 dgp Exp $ */ #ifndef _TCLINT @@ -385,6 +385,8 @@ typedef struct ActiveCommandTrace { * trace procedure returns; if this * trace gets deleted, must update pointer * to avoid using free'd memory. */ + int reverseScan; /* Boolean set true when traces + * are scanning in reverse order. */ } ActiveCommandTrace; /* @@ -796,6 +798,8 @@ typedef struct ActiveInterpTrace { * trace procedure returns; if this * trace gets deleted, must update pointer * to avoid using free'd memory. */ + int reverseScan; /* Boolean set true when traces + * are scanning in reverse order. */ } ActiveInterpTrace; /* diff --git a/generic/tclTrace.c b/generic/tclTrace.c index d482a6b..c3aaa82 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.24 2005/06/14 13:46:03 dkf Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.25 2005/06/21 18:33:05 dgp Exp $ */ #include "tclInt.h" @@ -1176,7 +1176,11 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData) for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { - activePtr->nextTracePtr = tracePtr->nextPtr; + if (activePtr->reverseScan) { + activePtr->nextTracePtr = prevPtr; + } else { + activePtr->nextTracePtr = tracePtr->nextPtr; + } } } if (prevPtr == NULL) { @@ -1395,6 +1399,7 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, tracePtr = active.nextTracePtr) { if (traceFlags & TCL_TRACE_LEAVE_EXEC) { /* execute the trace command in order of creation for "leave" */ + active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = cmdPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { @@ -1402,6 +1407,7 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, tracePtr = tracePtr->nextPtr; } } else { + active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; @@ -1418,7 +1424,9 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, ckfree((char*)tcmdPtr); } } - lastTracePtr = tracePtr; + if (active.nextTracePtr) { + lastTracePtr = active.nextTracePtr->nextPtr; + } } iPtr->activeCmdTracePtr = active.nextPtr; if (state) { @@ -1493,6 +1501,7 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, * Tcl_CreateObjTrace creates one more linked list of traces * which results in one more reversal of trace invocation. */ + active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = iPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { @@ -1500,6 +1509,7 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, tracePtr = tracePtr->nextPtr; } } else { + active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->level > 0 && curLevel > tracePtr->level) { @@ -1547,7 +1557,9 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; Tcl_Release((ClientData) tracePtr); } - lastTracePtr = tracePtr; + if (active.nextTracePtr) { + lastTracePtr = active.nextTracePtr->nextPtr; + } } iPtr->activeInterpTracePtr = active.nextPtr; if (state) { @@ -2219,15 +2231,18 @@ Tcl_DeleteTrace(interp, trace) * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; - Trace *tracePtr = (Trace *) trace; + Trace *prevPtr, *tracePtr = (Trace *) trace; register Trace **tracePtr2 = &(iPtr->tracePtr); + ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, * and remove it from the list. */ + prevPtr = NULL; while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) { + prevPtr = *tracePtr2; tracePtr2 = &((*tracePtr2)->nextPtr); } if (*tracePtr2 == NULL) { @@ -2236,6 +2251,23 @@ 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) { + if (activePtr->reverseScan) { + activePtr->nextTracePtr = prevPtr; + } else { + 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 e8b2ae7..d4a777f 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.37 2004/11/15 21:47:23 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.38 2005/06/21 18:33:05 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -2204,7 +2204,40 @@ test trace-33.1 {variable match with remove variable} { llength [trace info variable x] } 0 -test trace-34.1 {527164: Keep -errorinfo of traces} -setup { +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} + +test trace-34.2 {Bug 1224585} { + proc foo {} {} + proc bar args {trace remove execution foo leave soom} + trace add execution foo leave bar + trace add execution foo leave soom + foo +} {} + +test trace-34.3 {Bug 1224585} { + proc foo {} {set x {}} + proc bar args {trace remove execution foo enterstep soom} + trace add execution foo enterstep soom + trace add execution foo enterstep bar + foo +} {} + +test trace-35.1 {527164: Keep -errorinfo of traces} -setup { unset -nocomplain x y } -body { trace add variable x write {error foo;#} |