Tcl Source Code

Artifact [201f08fbe0]
Login

Artifact 201f08fbe009f94fad44c38a6eb007943aea5d5f:

Attachment "trace.cdiff" to ticket [615043ffff] added by vincentdarley 2002-10-15 00:17:51.
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.76
diff -r1.76 tclCmdMZ.c
49c49,54
<     int startLevel;             /* Used for bookkeeping with execution traces */
---
>     int startLevel;             /* Used for bookkeeping with step execution
>                                  * traces, store the level at which the step
>                                  * trace was invoked */
>     char *startCmd;             /* Used for bookkeeping with step execution
>                                  * traces, store the command name which invoked
>                                  * step trace */
3189a3195
>               tcmdPtr->startCmd = NULL;
3238a3245,3247
>                             if (tcmdPtr->startCmd != NULL) {
>                               ckfree((char *)tcmdPtr->startCmd);
>                           }
3390a3400
>               tcmdPtr->startCmd = NULL;
3965a3976,3978
>             if (tcmdPtr->startCmd != NULL) {
>               ckfree((char *)tcmdPtr->startCmd);
>           }
4292c4305,4306
<        * created an interpreter trace, we remove it
---
>        * created an interpreter trace for enterstep and/or leavestep
>          * execution traces, we remove it here.
4295c4309,4310
<           if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)) {
---
>           if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)
>                 && (strcmp(command, tcmdPtr->startCmd) == 0)) {
4297a4313,4315
>                 if (tcmdPtr->startCmd != NULL) {
>                   ckfree((char *)tcmdPtr->startCmd);
>               }
4299d4316
<           
4384,4385c4401,4406
<        * Third, create an interpreter trace, if we need one for
<        * subsequent internal execution traces.
---
>        * Third, if there are any step execution traces for this proc,
>          * we register an interpreter trace to invoke enterstep and/or
>        * leavestep traces.
>        * We also need to save the current stack level and the proc
>          * string in startLevel and startCmd so that we can delete this
>          * interpreter trace when it reaches the end of this proc.
4389a4411,4413
>               tcmdPtr->startCmd = 
>                   (char *) ckalloc((unsigned) (strlen(command) + 1));
>               strcpy(tcmdPtr->startCmd, command);
4398a4423,4425
>             if (tcmdPtr->startCmd != NULL) {
>               ckfree((char *)tcmdPtr->startCmd);
>           }
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.22
diff -r1.22 trace.test
1840a1841,1870
> test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} {
>     catch {rename foo {}}
>     proc foo {} {
>         set a 1
>         update idletasks
>         set b 1
>     }
> 
>     set info {}
>     trace add execution foo {enter enterstep leavestep leave} \
>         [list traceExecute foo]
>     update
>     after idle {puts idle}
>     foo
> 
>     trace remove execution foo {enter enterstep leavestep leave} \
>         [list traceExecute foo]
>     rename foo {}
>     join $info "\n"
> } {foo foo enter
> foo {set a 1} enterstep
> foo {set a 1} 0 1 leavestep
> foo {update idletasks} enterstep
> foo {puts idle} enterstep
> foo {puts idle} 0 {} leavestep
> foo {update idletasks} 0 {} leavestep
> foo {set b 1} enterstep
> foo {set b 1} 0 1 leavestep
> foo foo 0 1 leave}
> 
1845a1876,1878
> 
> # Unset the varaible when done
> catch {unset info}