diff options
author | dgp <dgp@users.sourceforge.net> | 2023-06-07 17:24:24 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2023-06-07 17:24:24 (GMT) |
commit | b7bfaa423c2abba0cb1f1a86eb4e5cfbeb19bce8 (patch) | |
tree | 748289834632ca8c6fad6b2335ad0f5a45cdd9d3 /generic | |
parent | 5140d2419c9c9705ba10631ce5367690f670dabc (diff) | |
download | tcl-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.h | 4 | ||||
-rw-r--r-- | 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); |