Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-673 Excluding Merge-Ins
This is equivalent to a diff from 0c9e96526c to 300e39bbc4
2023-09-27
| ||
12:27 | TIP #673: Remove deprecated [trace] subcommands check-in: 064ef7e691 user: jan.nijtmans tags: trunk, main | |
2023-09-07
| ||
11:09 | Merge 8.7 check-in: cc85b6cac2 user: jan.nijtmans tags: trunk, main | |
2023-09-06
| ||
20:35 | merge trunk Closed-Leaf check-in: 300e39bbc4 user: dgp tags: tip-673 | |
19:49 | merge trunk check-in: 60c2564000 user: dgp tags: dgp-refactor | |
19:43 | merge trunk check-in: 0c87cd0fb8 user: dgp tags: novem | |
19:29 | merge trunk check-in: ea2012c75e user: dgp tags: core-9-0-b1-rc | |
19:28 | merge 8.7 check-in: 0c9e96526c user: dgp tags: trunk, main | |
18:40 | [fc87e3bddd] Complete repair of flawed test. check-in: dec5990363 user: dgp tags: core-8-branch | |
16:08 | merge 8.7 check-in: 5f1ed63f27 user: dgp tags: trunk, main | |
2023-08-04
| ||
07:48 | Rebase to 9.0 check-in: 3e13e79524 user: jan.nijtmans tags: tip-673 | |
Changes to doc/trace.n.
︙ | ︙ | |||
352 353 354 355 356 357 358 | Returns a list containing one element for each trace currently set on variable \fIname\fR. Each element of the list is itself a list containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR associated with the trace. If \fIname\fR does not exist or does not have any traces set, then the result of the command will be an empty string. .RE | < < < < < < < < < < < < < < < < < < < < | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | Returns a list containing one element for each trace currently set on variable \fIname\fR. Each element of the list is itself a list containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR associated with the trace. If \fIname\fR does not exist or does not have any traces set, then the result of the command will be an empty string. .RE .SH EXAMPLES .PP Print a message whenever either of the global variables \fBfoo\fR and \fBbar\fR are updated, even if they have a different local name at the time (which can be done with the \fBupvar\fR command): .PP .CS |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
986 987 988 989 990 991 992 | #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 | < < < < | 986 987 988 989 990 991 992 993 994 995 996 997 998 999 | #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 /* Indicate the semantics of the result of a trace. */ #define TCL_TRACE_RESULT_DYNAMIC 0x8000 #define TCL_TRACE_RESULT_OBJECT 0x10000 /* * Flag values for ensemble commands. */ |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
88 89 90 91 92 93 94 | #define TCL_TRACE_EXEC_IN_PROGRESS 0x10 #define TCL_TRACE_EXEC_DIRECT 0x20 /* * Forward declarations for functions defined in this file: */ | < < < < | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | #define TCL_TRACE_EXEC_IN_PROGRESS 0x10 #define TCL_TRACE_EXEC_DIRECT 0x20 /* * Forward declarations for functions defined in this file: */ enum traceOptionsEnum { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, enum traceOptionsEnum optionIndex, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_TraceTypeObjCmd TraceVariableObjCmd; static Tcl_TraceTypeObjCmd TraceCommandObjCmd; static Tcl_TraceTypeObjCmd TraceExecutionObjCmd; |
︙ | ︙ | |||
191 192 193 194 195 196 197 | int Tcl_TraceObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < < < < < < < | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | int Tcl_TraceObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* Main sub commands to 'trace' */ static const char *const traceOptions[] = { "add", "info", "remove", NULL }; enum traceOptionsEnum optionIndex; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
260 261 262 263 264 265 266 | 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); break; } | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TraceExecutionObjCmd -- * |
︙ | ︙ | |||
615 616 617 618 619 620 621 | Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, Tcl_NewStringObj(tcmdPtr->command, -1)); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } | < < < < | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 | Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, Tcl_NewStringObj(tcmdPtr->command, -1)); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
813 814 815 816 817 818 819 | elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } | < < < < | 690 691 692 693 694 695 696 697 698 699 700 701 702 703 | elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
917 918 919 920 921 922 923 | command = Tcl_GetStringFromObj(objv[5], &length); if (optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; | < < < < < | 790 791 792 793 794 795 796 797 798 799 800 801 802 803 | command = Tcl_GetStringFromObj(objv[5], &length); if (optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; ctvarPtr->traceCmdInfo.length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; memcpy(ctvarPtr->traceCmdInfo.command, command, length+1); ctvarPtr->traceInfo.traceProc = TraceVarProc; ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo; ctvarPtr->traceInfo.flags = flags; name = TclGetString(objv[3]); |
︙ | ︙ | |||
946 947 948 949 950 951 952 | */ name = TclGetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; if ((tvarPtr->length == length) | | < < < < | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 | */ name = TclGetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; if ((tvarPtr->length == length) && ((tvarPtr->flags)==flags) && (strncmp(command, tvarPtr->command, length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); break; } |
︙ | ︙ | |||
1010 1011 1012 1013 1014 1015 1016 | Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } | < < < < | 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr); break; } } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1985 1986 1987 1988 1989 1990 1991 | TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *result; int code, destroy = 0; Tcl_DString cmd; int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* | | | | | < < < < < < < < < < < < < < < < | 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 | TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *result; int code, destroy = 0; Tcl_DString cmd; int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* * We might call Tcl_EvalEx() below, and that might evaluate * [trace remove variable] which might try to free tvarPtr. We want to * use tvarPtr until the end of this function, so we use Tcl_Preserve() * and Tcl_Release() to be sure it is not freed while we still need it. */ result = NULL; if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { if (tvarPtr->length) { /* * Generate a command to execute by appending list elements for * the two variable names and the operation. */ Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " unset"); } /* * Execute the command. We discard any object result the command * returns. * * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to * other areas that this will be destroyed by us, otherwise a |
︙ | ︙ | |||
2955 2956 2957 2958 2959 2960 2961 | /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; | < < < | 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 | /* * Set up a mask to mask out the parts of the flags that we are not * interested in now. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; flags &= flagMask; hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { goto updateFlags; |
︙ | ︙ | |||
3222 3223 3224 3225 3226 3227 3228 | /* * Set up trace information. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; | < < < | 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 | /* * Set up trace information. */ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; tracePtr->flags = tracePtr->flags & flagMask; hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew); if (isNew) { tracePtr->nextPtr = NULL; } else { tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr); |
︙ | ︙ |
Changes to tests/trace.test.
︙ | ︙ | |||
867 868 869 870 871 872 873 | } [list 1 "wrong # args: should be \"trace remove type ?arg ...?\""] test trace-14.4 "trace command, wrong # args errors" { list [catch {trace info} msg] $msg } [list 1 "wrong # args: should be \"trace info type name\""] test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg | | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | } [list 1 "wrong # args: should be \"trace remove type ?arg ...?\""] test trace-14.4 "trace command, wrong # args errors" { list [catch {trace info} msg] $msg } [list 1 "wrong # args: should be \"trace info type name\""] test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg } [list 1 "bad option \"gorp\": must be add, info, or remove"] # Again, [trace ... command] and [trace ... variable] share syntax and # error message styles for their opList options; these loops test those # error messages. set i 0 set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"] |
︙ | ︙ | |||
893 894 895 896 897 898 899 | } test trace-14.6.[incr i] "trace $op $type rejects null opList" { list [catch {trace $op $type x {} a} msg] $msg } [list 1 "bad operation list \"\": must be one or more of $err"] } } rename x {} | < < < < < < < < < < < < < < < < < | 893 894 895 896 897 898 899 900 901 902 903 904 905 906 | } test trace-14.6.[incr i] "trace $op $type rejects null opList" { list [catch {trace $op $type x {} a} msg] $msg } [list 1 "bad operation list \"\": must be one or more of $err"] } } rename x {} test trace-14.12 {trace command ("remove variable" option)} { unset -nocomplain x set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} |
︙ | ︙ | |||
1230 1231 1232 1233 1234 1235 1236 | test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} set info {} p1 foo bar set info } {0 {a x y}} | | | | | | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 | test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} set info {} p1 foo bar set info } {0 {a x y}} test trace-18.2 {namespace delete / trace remove variable combo} { namespace eval ::foo { variable x 123 } proc p1 args { trace remove variable ::foo::x unset p1 } trace add variable ::foo::x unset p1 namespace delete ::foo info exists ::foo::x } 0 test trace-18.3 {namespace delete / trace remove variable combo, Bug \#1337229} { namespace eval ::ns {} trace add variable ::ns::var unset {unset ::ns::var ;#} namespace delete ::ns } {} test trace-18.4 {namespace delete / trace remove variable combo, Bug \#1338280} { namespace eval ::ref {} set ::ref::var1 AAA trace add variable ::ref::var1 unset doTrace set ::ref::var2 BBB trace add variable ::ref::var2 {unset} doTrace proc doTrace {vtraced vidx op} { global info |
︙ | ︙ |