Skip to content

Commit

Permalink
TIP #673: Remove deprecated [trace] subcommands
Browse files Browse the repository at this point in the history
  • Loading branch information
jan.nijtmans committed Sep 27, 2023
2 parents 69e6a0f + acf03d5 commit 029ef67
Show file tree
Hide file tree
Showing 4 changed files with 2 additions and 205 deletions.
20 changes: 0 additions & 20 deletions doc/trace.n
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 0 additions & 4 deletions generic/tcl.h
Original file line number Diff line number Diff line change
Expand Up @@ -998,10 +998,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
Expand Down
164 changes: 1 addition & 163 deletions generic/tclTrace.c
Original file line number Diff line number Diff line change
Expand Up @@ -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[]);
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
}

/*
Expand Down Expand Up @@ -619,10 +500,6 @@ TraceExecutionObjCmd(
Tcl_SetObjResult(interp, resultListPtr);
break;
}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
default:
break;
#endif
}
return TCL_OK;
}
Expand Down Expand Up @@ -817,10 +694,6 @@ TraceCommandObjCmd(
Tcl_SetObjResult(interp, resultListPtr);
break;
}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
default:
break;
#endif
}
return TCL_OK;
}
Expand Down Expand Up @@ -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);
Expand All @@ -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,
Expand Down Expand Up @@ -1014,10 +878,6 @@ TraceVariableObjCmd(
Tcl_SetObjResult(interp, resultListPtr);
break;
}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
default:
break;
#endif
}
return TCL_OK;
}
Expand Down Expand Up @@ -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) {
Expand All @@ -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
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down
19 changes: 1 addition & 18 deletions tests/trace.test
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 {}
Expand Down

0 comments on commit 029ef67

Please sign in to comment.