From b7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 7 Jun 2023 17:24:24 +0000 Subject: WIP on TIP 673. First pass exposes issues in the test suite. --- generic/tcl.h | 4 -- generic/tclTrace.c | 172 ++--------------------------------------------------- 2 files changed, 5 insertions(+), 171 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index b43fcec..e010afa 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -943,10 +943,6 @@ typedef struct Tcl_DString { #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 -#ifndef TCL_REMOVE_OBSOLETE_TRACES -/* Required to support old variable/vdelete/vinfo traces. */ -#define TCL_TRACE_OLD_STYLE 0x1000 -#endif /* Indicate the semantics of the result of a trace. */ #define TCL_TRACE_RESULT_DYNAMIC 0x8000 #define TCL_TRACE_RESULT_OBJECT 0x10000 diff --git a/generic/tclTrace.c b/generic/tclTrace.c index a527fcc..b1e1e44 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -92,12 +92,8 @@ typedef struct { * Forward declarations for functions defined in this file: */ -/* 'OLD' options are pre-Tcl-8.4 style */ enum traceOptionsEnum { TRACE_ADD, TRACE_INFO, TRACE_REMOVE -#ifndef TCL_REMOVE_OBSOLETE_TRACES - ,TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO -#endif }; typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, enum traceOptionsEnum optionIndex, Tcl_Size objc, Tcl_Obj *const objv[]); @@ -195,16 +191,9 @@ Tcl_TraceObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { -#ifndef TCL_REMOVE_OBSOLETE_TRACES - const char *name; - const char *flagOps, *p; -#endif /* Main sub commands to 'trace' */ static const char *const traceOptions[] = { "add", "info", "remove", -#ifndef TCL_REMOVE_OBSOLETE_TRACES - "variable", "vdelete", "vinfo", -#endif NULL }; enum traceOptionsEnum optionIndex; @@ -264,116 +253,8 @@ Tcl_TraceObjCmd( break; } -#ifndef TCL_REMOVE_OBSOLETE_TRACES - case TRACE_OLD_VARIABLE: - case TRACE_OLD_VDELETE: { - Tcl_Obj *copyObjv[6]; - Tcl_Obj *opsList; - int code; - Tcl_Size numFlags; - - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); - return TCL_ERROR; - } - - TclNewObj(opsList); - Tcl_IncrRefCount(opsList); - flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); - if (numFlags == 0) { - Tcl_DecrRefCount(opsList); - goto badVarOps; - } - for (p = flagOps; *p != 0; p++) { - Tcl_Obj *opObj; - - if (*p == 'r') { - TclNewLiteralStringObj(opObj, "read"); - } else if (*p == 'w') { - TclNewLiteralStringObj(opObj, "write"); - } else if (*p == 'u') { - TclNewLiteralStringObj(opObj, "unset"); - } else if (*p == 'a') { - TclNewLiteralStringObj(opObj, "array"); - } else { - Tcl_DecrRefCount(opsList); - goto badVarOps; - } - Tcl_ListObjAppendElement(NULL, opsList, opObj); - } - copyObjv[0] = NULL; - memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *)); - copyObjv[4] = opsList; - if (optionIndex == TRACE_OLD_VARIABLE) { - code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv); - } else { - code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv); - } - Tcl_DecrRefCount(opsList); - return code; - } - case TRACE_OLD_VINFO: { - void *clientData; - char ops[5]; - Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr; - - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "name"); - return TCL_ERROR; - } - TclNewObj(resultListPtr); - name = TclGetString(objv[2]); - FOREACH_VAR_TRACE(interp, name, clientData) { - TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; - char *q = ops; - - pairObjPtr = Tcl_NewListObj(0, NULL); - if (tvarPtr->flags & TCL_TRACE_READS) { - *q = 'r'; - q++; - } - if (tvarPtr->flags & TCL_TRACE_WRITES) { - *q = 'w'; - q++; - } - if (tvarPtr->flags & TCL_TRACE_UNSETS) { - *q = 'u'; - q++; - } - if (tvarPtr->flags & TCL_TRACE_ARRAY) { - *q = 'a'; - q++; - } - *q = '\0'; - - /* - * Build a pair (2-item list) with the ops string as the first obj - * element and the tvarPtr->command string as the second obj - * element. Append the pair (as an element) to the end of the - * result object list. - */ - - elemObjPtr = Tcl_NewStringObj(ops, -1); - Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr); - elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1); - Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr); - Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr); - } - Tcl_SetObjResult(interp, resultListPtr); - break; - } -#endif /* TCL_REMOVE_OBSOLETE_TRACES */ } return TCL_OK; - -#ifndef TCL_REMOVE_OBSOLETE_TRACES - badVarOps: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad operations \"%s\": should be one or more of rwua", - flagOps)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL); - return TCL_ERROR; -#endif } /* @@ -619,10 +500,6 @@ TraceExecutionObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_REMOVE_OBSOLETE_TRACES - default: - break; -#endif } return TCL_OK; } @@ -817,10 +694,6 @@ TraceCommandObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_REMOVE_OBSOLETE_TRACES - default: - break; -#endif } return TCL_OK; } @@ -921,11 +794,6 @@ TraceVariableObjCmd( + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; -#ifndef TCL_REMOVE_OBSOLETE_TRACES - if (objv[0] == NULL) { - ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE; - } -#endif ctvarPtr->traceCmdInfo.length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; memcpy(ctvarPtr->traceCmdInfo.command, command, length+1); @@ -950,11 +818,7 @@ TraceVariableObjCmd( TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; if ((tvarPtr->length == length) - && ((tvarPtr->flags -#ifndef TCL_REMOVE_OBSOLETE_TRACES -& ~TCL_TRACE_OLD_STYLE -#endif - )==flags) + && ((tvarPtr->flags)==flags) && (strncmp(command, tvarPtr->command, length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, @@ -1014,10 +878,6 @@ TraceVariableObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_REMOVE_OBSOLETE_TRACES - default: - break; -#endif } return TCL_OK; } @@ -1989,10 +1849,10 @@ TraceVarProc( int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* - * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete] - * 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. + * 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; @@ -2008,19 +1868,6 @@ TraceVarProc( Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); -#ifndef TCL_REMOVE_OBSOLETE_TRACES - if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { - if (flags & TCL_TRACE_ARRAY) { - TclDStringAppendLiteral(&cmd, " a"); - } else if (flags & TCL_TRACE_READS) { - TclDStringAppendLiteral(&cmd, " r"); - } else if (flags & TCL_TRACE_WRITES) { - TclDStringAppendLiteral(&cmd, " w"); - } else if (flags & TCL_TRACE_UNSETS) { - TclDStringAppendLiteral(&cmd, " u"); - } - } else { -#endif if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { @@ -2030,9 +1877,6 @@ TraceVarProc( } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " unset"); } -#ifndef TCL_REMOVE_OBSOLETE_TRACES - } -#endif /* * Execute the command. We discard any object result the command @@ -2959,9 +2803,6 @@ Tcl_UntraceVar2( flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; -#ifndef TCL_REMOVE_OBSOLETE_TRACES - flagMask |= TCL_TRACE_OLD_STYLE; -#endif flags &= flagMask; hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); @@ -3226,9 +3067,6 @@ TraceVarEx( flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; -#ifndef TCL_REMOVE_OBSOLETE_TRACES - flagMask |= TCL_TRACE_OLD_STYLE; -#endif tracePtr->flags = tracePtr->flags & flagMask; hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew); -- cgit v0.12 From 35531e2f3ceb40a9f6bc698a14bbf17d66d9aae2 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 21 Jun 2023 16:08:57 +0000 Subject: A few more test updates. --- tests/trace.test | 27 +++++---------------------- 1 file changed, 5 insertions(+), 22 deletions(-) diff --git a/tests/trace.test b/tests/trace.test index d3c2dad..64c9111 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -871,7 +871,7 @@ test trace-14.4 "trace command, wrong # args errors" { test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg -} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"] +} [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 @@ -898,23 +898,6 @@ foreach type {variable command execution} err $errs abbvlist $abbvs { } rename x {} -test trace-14.7 {trace command, "trace variable" errors} { - list [catch {trace variable} msg] $msg -} [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-14.8 {trace command, "trace variable" errors} { - list [catch {trace variable x} msg] $msg -} [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-14.9 {trace command, "trace variable" errors} { - list [catch {trace variable x y} msg] $msg -} [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-14.10 {trace command, "trace variable" errors} { - list [catch {trace variable x y z w} msg] $msg -} [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-14.11 {trace command, "trace variable" errors} { - list [catch {trace variable x y z} msg] $msg -} [list 1 "bad operations \"y\": should be one or more of rwua"] - - test trace-14.12 {trace command ("remove variable" option)} { unset -nocomplain x set info {} @@ -1234,23 +1217,23 @@ test trace-18.1 {unset traces on procedure returns} { p1 foo bar set info } {0 {a x y}} -test trace-18.2 {namespace delete / trace vdelete combo} { +test trace-18.2 {namespace delete / trace remove variable combo} { namespace eval ::foo { variable x 123 } proc p1 args { - trace vdelete ::foo::x u p1 + 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 vdelete combo, Bug \#1337229} { +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 vdelete combo, Bug \#1338280} { +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 -- cgit v0.12 From eea1ed4e1a26f35dbbc707cbad703147a2320c91 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 28 Jun 2023 17:06:40 +0000 Subject: Remove documentation of deleted subcomands. --- doc/trace.n | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/doc/trace.n b/doc/trace.n index d54b17f..72b415b 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -356,26 +356,6 @@ 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 -.PP -For backwards compatibility, three other subcommands are available: -.RS -.TP -\fBtrace variable \fIname ops command\fR -This is equivalent to \fBtrace add variable \fIname ops command\fR. -.TP -\fBtrace vdelete \fIname ops command\fR -This is equivalent to \fBtrace remove variable \fIname ops command\fR -.TP -\fBtrace vinfo \fIname\fR -This is equivalent to \fBtrace info variable \fIname\fR -.RE -.PP -These subcommands are deprecated and will likely be removed in a -future version of Tcl. They use an older syntax in which \fBarray\fR, -\fBread\fR, \fBwrite\fR, \fBunset\fR are replaced by \fBa\fR, \fBr\fR, -\fBw\fR and \fBu\fR respectively, and the \fIops\fR argument is not a -list, but simply a string concatenation of the operations, such as -\fBrwua\fR. .SH EXAMPLES .PP Print a message whenever either of the global variables \fBfoo\fR and -- cgit v0.12