summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2023-06-07 17:24:24 (GMT)
committerdgp <dgp@users.sourceforge.net>2023-06-07 17:24:24 (GMT)
commitb7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8 (patch)
tree748289834632ca8c6fad6b2335ad0f5a45cdd9d3 /generic
parent5140d2419c9c9705ba10631ce5367690f670dabc (diff)
downloadtcl-b7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8.zip
tcl-b7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8.tar.gz
tcl-b7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8.tar.bz2
WIP on TIP 673. First pass exposes issues in the test suite.
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclTrace.c172
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);