Tcl Source Code

Artifact 19a5ec30885ea22f6d5bdd2fe492601ee02eff53:

Attachment "1224585.patch" to ticket [1224585fff] added by dgp 2005-06-22 00:13:00.

---

Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.75.2.15
diff -u -r1.75.2.15 tclBasic.c
--- generic/tclBasic.c	21 Jun 2005 14:44:58 -0000	1.75.2.15
+++ generic/tclBasic.c	21 Jun 2005 17:11:49 -0000
@@ -2585,6 +2585,7 @@
     
     result = NULL;
     active.nextPtr = iPtr->activeCmdTracePtr;
+    active.reverseScan = 0;
     iPtr->activeCmdTracePtr = &active;
 
     if (flags & TCL_TRACE_DELETE) {
@@ -5158,7 +5159,7 @@
 				 * Tcl_CreateTrace). */
 {
     Interp *iPtr = (Interp *) interp;
-    Trace *tracePtr = (Trace *) trace;
+    Trace *prevPtr, *tracePtr = (Trace *) trace;
     register Trace **tracePtr2 = &(iPtr->tracePtr);
     ActiveInterpTrace *activePtr;
 
@@ -5167,7 +5168,9 @@
      * and remove it from the list.
      */
 
+    prevPtr = NULL;
     while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
+	prevPtr = *tracePtr2;
 	tracePtr2 = &((*tracePtr2)->nextPtr);
     }
     if (*tracePtr2 == NULL) {
@@ -5184,7 +5187,11 @@
     for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
 	    activePtr = activePtr->nextPtr) {
 	if (activePtr->nextTracePtr == tracePtr) {
-	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	    if (activePtr->reverseScan) {
+		activePtr->nextTracePtr = prevPtr;
+	    } else {
+		activePtr->nextTracePtr = tracePtr->nextPtr;
+	    }
 	}
     }
 
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.82.2.19
diff -u -r1.82.2.19 tclCmdMZ.c
--- generic/tclCmdMZ.c	25 May 2005 19:25:57 -0000	1.82.2.19
+++ generic/tclCmdMZ.c	21 Jun 2005 17:11:49 -0000
@@ -3972,7 +3972,11 @@
     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) {
@@ -4201,6 +4205,7 @@
 	 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) {
@@ -4208,6 +4213,7 @@
 	        tracePtr = tracePtr->nextPtr;
             }
         } else {
+	    active.reverseScan = 0;
 	    active.nextTracePtr = tracePtr->nextPtr;
         }
 	tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
@@ -4225,7 +4231,9 @@
 	        ckfree((char*)tcmdPtr);
 	    }
 	}
-        lastTracePtr = tracePtr;
+	if (active.nextTracePtr) {
+	    lastTracePtr = active.nextTracePtr->nextPtr;
+	}
     }
     iPtr->activeCmdTracePtr = active.nextPtr;
     return(traceCode);
@@ -4296,6 +4304,7 @@
              * 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) {
@@ -4303,6 +4312,7 @@
 	        tracePtr = tracePtr->nextPtr;
             }
         } else {
+	    active.reverseScan = 0;
 	    active.nextTracePtr = tracePtr->nextPtr;
         }
 	if (tracePtr->level > 0 && curLevel > tracePtr->level) {
@@ -4347,7 +4357,9 @@
 	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
 	    Tcl_Release((ClientData) tracePtr);
 	}
-        lastTracePtr = tracePtr;
+	if (active.nextTracePtr) {
+	    lastTracePtr = active.nextTracePtr->nextPtr;
+	}
     }
     iPtr->activeInterpTracePtr = active.nextPtr;
     return(traceCode);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118.2.11
diff -u -r1.118.2.11 tclInt.h
--- generic/tclInt.h	18 Jun 2005 21:46:42 -0000	1.118.2.11
+++ generic/tclInt.h	21 Jun 2005 17:11:49 -0000
@@ -336,6 +336,8 @@
 				 * trace procedure returns;  if this
 				 * trace gets deleted, must update pointer
 				 * to avoid using free'd memory. */
+    int reverseScan;		/* Boolean set true when the traces
+				 * are scanning in reverse order. */
 } ActiveCommandTrace;
 
 /*
@@ -709,6 +711,8 @@
 				 * trace procedure returns;  if this
 				 * trace gets deleted, must update pointer
 				 * to avoid using free'd memory. */
+    int reverseScan;		/* Boolean set true when the traces
+				 * are scanning in reverse order. */
 } ActiveInterpTrace;
 
 /*
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.26.2.5
diff -u -r1.26.2.5 trace.test
--- tests/trace.test	21 Jun 2005 14:44:59 -0000	1.26.2.5
+++ tests/trace.test	21 Jun 2005 17:11:50 -0000
@@ -2156,6 +2156,22 @@
     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
+} {}
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}