diff options
| -rw-r--r-- | generic/tclTrace.c | 251 | ||||
| -rw-r--r-- | generic/tclVar.c | 126 |
2 files changed, 206 insertions, 171 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c index c67515f..b614b45 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTrace.c,v 1.45 2007/09/17 10:44:05 dkf Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.46 2007/11/15 09:40:00 dkf Exp $ */ #include "tclInt.h" @@ -96,7 +96,7 @@ typedef struct { */ typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static Tcl_TraceTypeObjCmd TraceVariableObjCmd; static Tcl_TraceTypeObjCmd TraceCommandObjCmd; @@ -109,7 +109,7 @@ static Tcl_TraceTypeObjCmd TraceExecutionObjCmd; * add to the list of supported trace types. */ -static CONST char *traceTypeOptions[] = { +static const char *traceTypeOptions[] = { "execution", "command", "variable", NULL }; static Tcl_TraceTypeObjCmd *traceSubCmds[] = { @@ -123,22 +123,22 @@ static Tcl_TraceTypeObjCmd *traceSubCmds[] = { */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, - Command *cmdPtr, CONST char *command, int numChars, - int objc, Tcl_Obj *CONST objv[]); + Command *cmdPtr, const char *command, int numChars, + int objc, Tcl_Obj *const objv[]); static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, - CONST char *name1, CONST char *name2, int flags); + const char *name1, const char *name2, int flags); static void TraceCommandProc(ClientData clientData, - Tcl_Interp *interp, CONST char *oldName, - CONST char *newName, int flags); + Tcl_Interp *interp, const char *oldName, + const char *newName, int flags); static Tcl_CmdObjTraceProc TraceExecutionProc; static int StringTraceProc(ClientData clientData, - Tcl_Interp* interp, int level, - CONST char* command, Tcl_Command commandInfo, - int objc, Tcl_Obj *CONST objv[]); + Tcl_Interp *interp, int level, + const char *command, Tcl_Command commandInfo, + int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); -static int TraceVarEx(Tcl_Interp *interp, CONST char *part1, - CONST char *part2, register VarTrace *tracePtr); +static int TraceVarEx(Tcl_Interp *interp, const char *part1, + const char *part2, register VarTrace *tracePtr); /* * The following structure holds the client data for string-based @@ -147,7 +147,7 @@ static int TraceVarEx(Tcl_Interp *interp, CONST char *part1, typedef struct StringTraceData { ClientData clientData; /* Client data from Tcl_CreateTrace */ - Tcl_CmdTraceProc* proc; /* Trace function from Tcl_CreateTrace */ + Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; /* @@ -175,12 +175,12 @@ Tcl_TraceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; char *name, *flagOps, *p; /* Main sub commands to 'trace' */ - static CONST char *traceOptions[] = { + static const char *traceOptions[] = { "add", "info", "remove", #ifndef TCL_REMOVE_OBSOLETE_TRACES "variable", "vdelete", "vinfo", @@ -384,7 +384,7 @@ TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; char *name, *command; @@ -392,7 +392,7 @@ TraceExecutionObjCmd( enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; - static CONST char *opStrings[] = { + static const char *opStrings[] = { "enter", "leave", "enterstep", "leavestep", NULL }; enum operations { @@ -523,7 +523,7 @@ TraceExecutionObjCmd( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { - ckfree((char *)tcmdPtr->startCmd); + ckfree((char *) tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { @@ -534,7 +534,7 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } if ((--tcmdPtr->refCount) <= 0) { - ckfree((char*)tcmdPtr); + ckfree((char *) tcmdPtr); } break; } @@ -638,13 +638,13 @@ TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; char *name, *command; size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; - static CONST char *opStrings[] = { "delete", "rename", NULL }; + static const char *opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; switch ((enum traceOptions) optionIndex) { @@ -836,13 +836,13 @@ TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int commandLength, index; char *name, *command; size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; - static CONST char *opStrings[] = { + static const char *opStrings[] = { "array", "read", "unset", "write", NULL }; enum operations { @@ -1028,7 +1028,7 @@ TraceVariableObjCmd( ClientData Tcl_CommandTraceInfo( Tcl_Interp *interp, /* Interpreter containing command. */ - CONST char *cmdName, /* Name of command. */ + const char *cmdName, /* Name of command. */ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ @@ -1094,7 +1094,7 @@ int Tcl_TraceCommand( Tcl_Interp *interp, /* Interpreter in which command is to be * traced. */ - CONST char *cmdName, /* Name of command. */ + const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ @@ -1149,7 +1149,7 @@ Tcl_TraceCommand( void Tcl_UntraceCommand( Tcl_Interp *interp, /* Interpreter containing command. */ - CONST char *cmdName, /* Name of command. */ + const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ @@ -1163,7 +1163,7 @@ Tcl_UntraceCommand( ActiveCommandTrace *activePtr; int hasExecTraces = 0; - cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, NULL, + cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return; @@ -1211,7 +1211,7 @@ Tcl_UntraceCommand( tracePtr->flags = 0; if ((--tracePtr->refCount) <= 0) { - ckfree((char*)tracePtr); + ckfree((char *) tracePtr); } if (hasExecTraces) { @@ -1254,8 +1254,8 @@ static void TraceCommandProc( ClientData clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ - CONST char *oldName, /* Name of command being changed. */ - CONST char *newName, /* New name of command. Empty string or NULL + const char *oldName, /* Name of command being changed. */ + const char *newName, /* New name of command. Empty string or NULL * means command is being deleted (renamed to * ""). */ int flags) /* OR-ed bits giving operation and other @@ -1318,7 +1318,7 @@ TraceCommandProc( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { - ckfree((char *)tcmdPtr->startCmd); + ckfree((char *) tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { @@ -1361,7 +1361,7 @@ TraceCommandProc( tcmdPtr->refCount--; } if ((--tcmdPtr->refCount) <= 0) { - ckfree((char*)tcmdPtr); + ckfree((char *) tcmdPtr); } } @@ -1393,7 +1393,7 @@ TraceCommandProc( int TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ - CONST char *command, /* Pointer to beginning of the current command + const char *command, /* Pointer to beginning of the current command * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ @@ -1401,14 +1401,13 @@ TclCheckExecutionTraces( int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ - Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */ + Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; CommandTrace *tracePtr, *lastTracePtr; ActiveCommandTrace active; int curLevel; int traceCode = TCL_OK; - TraceCommandInfo* tcmdPtr; Tcl_InterpState state = NULL; if (cmdPtr->tracePtr == NULL) { @@ -1442,7 +1441,9 @@ TclCheckExecutionTraces( active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->traceProc == TraceCommandProc) { - tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) + tracePtr->clientData; + if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; @@ -1450,10 +1451,10 @@ TclCheckExecutionTraces( if (state == NULL) { state = Tcl_SaveInterpState(interp, code); } - traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, - curLevel, command, (Tcl_Command)cmdPtr, objc, objv); + traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp, + curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if ((--tcmdPtr->refCount) <= 0) { - ckfree((char*)tcmdPtr); + ckfree((char *) tcmdPtr); } } } @@ -1495,7 +1496,7 @@ TclCheckExecutionTraces( int TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ - CONST char *command, /* Pointer to beginning of the current command + const char *command, /* Pointer to beginning of the current command * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ @@ -1503,7 +1504,7 @@ TclCheckInterpTraces( int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ - Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */ + Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; Trace *tracePtr, *lastTracePtr; @@ -1578,10 +1579,11 @@ TclCheckInterpTraces( if (tracePtr->flags & traceFlags) { if (tracePtr->proc == TraceExecutionProc) { - TraceCommandInfo* tcmdPtr = - (TraceCommandInfo *) tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) + tracePtr->clientData; + tcmdPtr->curFlags = traceFlags; - tcmdPtr->curCode = code; + tcmdPtr->curCode = code; } traceCode = (tracePtr->proc)(tracePtr->clientData, interp, curLevel, command, (Tcl_Command) cmdPtr, @@ -1642,12 +1644,12 @@ CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ register Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ - CONST char *command, /* Points to the first character of the + const char *command, /* Points to the first character of the * command's source before substitutions. */ int numChars, /* The number of characters in the command's * source. */ register int objc, /* Number of arguments for the command. */ - Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */ + Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; char *commandCopy; @@ -1658,14 +1660,14 @@ CallTraceFunction( */ commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1)); - memcpy((void *) commandCopy, (void *) command, (size_t) numChars); + memcpy(commandCopy, command, (size_t) numChars); commandCopy[numChars] = '\0'; /* * Call the trace function then free allocated storage. */ - traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*) iPtr, + traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr, iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv); TclStackFree(interp, commandCopy); @@ -1693,9 +1695,10 @@ static void CommandObjTraceDeleted( ClientData clientData) { - TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; + if ((--tcmdPtr->refCount) <= 0) { - ckfree((char*)tcmdPtr); + ckfree((char *) tcmdPtr); } } @@ -1729,17 +1732,17 @@ TraceExecutionProc( ClientData clientData, Tcl_Interp *interp, int level, - CONST char *command, + const char *command, Tcl_Command cmdInfo, int objc, - struct Tcl_Obj *CONST objv[]) + struct Tcl_Obj *const objv[]) { int call = 0; Interp *iPtr = (Interp *) interp; - TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int flags = tcmdPtr->curFlags; - int code = tcmdPtr->curCode; - int traceCode = TCL_OK; + int code = tcmdPtr->curCode; + int traceCode = TCL_OK; if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -1778,7 +1781,7 @@ TraceExecutionProc( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { - ckfree((char *)tcmdPtr->startCmd); + ckfree((char *) tcmdPtr->startCmd); } } @@ -1816,8 +1819,8 @@ TraceExecutionProc( Tcl_DStringAppendElement(&cmd, "enterstep"); } } else if (flags & TCL_TRACE_LEAVE_EXEC) { - Tcl_Obj* resultCode; - char* resultCodeStr; + Tcl_Obj *resultCode; + char *resultCodeStr; /* * Append result code. @@ -1866,10 +1869,11 @@ TraceExecutionProc( traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; - /* - * Restore the interp tracing flag to prevent cmd traces - * from affecting interp traces. + /* + * Restore the interp tracing flag to prevent cmd traces from + * affecting interp traces. */ + iPtr->flags = saveInterpFlags; if (tcmdPtr->flags == 0) { flags |= TCL_TRACE_DESTROYED; @@ -1888,10 +1892,11 @@ TraceExecutionProc( if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { + register unsigned len = strlen(command) + 1; + tcmdPtr->startLevel = level; - tcmdPtr->startCmd = - (char *) ckalloc((unsigned) (strlen(command) + 1)); - strcpy(tcmdPtr->startCmd, command); + tcmdPtr->startCmd = ckalloc(len); + memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, @@ -1904,13 +1909,13 @@ TraceExecutionProc( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { - ckfree((char *)tcmdPtr->startCmd); + ckfree(tcmdPtr->startCmd); } } } if (call) { if ((--tcmdPtr->refCount) <= 0) { - ckfree((char*)tcmdPtr); + ckfree((char *) tcmdPtr); } } return traceCode; @@ -1939,8 +1944,8 @@ static char * TraceVarProc( ClientData clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *name1, /* Name of variable or array. */ - CONST char *name2, /* Name of element within array; NULL means + const char *name1, /* Name of variable or array. */ + const char *name2, /* Name of element within array; NULL means * scalar variable is being referenced. */ int flags) /* OR-ed bits giving operation and other * information. */ @@ -2046,12 +2051,12 @@ TraceVarProc( * form: * * void proc(ClientData clientData, - * Tcl_Interp* interp, + * Tcl_Interp * interp, * int level, - * CONST char* command, + * const char * command, * Tcl_Command commandInfo, * int objc, - * Tcl_Obj *CONST objv[]); + * Tcl_Obj *const objv[]); * * The 'clientData' and 'interp' arguments to 'proc' will be the same as * the arguments to Tcl_CreateObjTrace. The 'level' argument gives the @@ -2090,12 +2095,12 @@ TraceVarProc( Tcl_Trace Tcl_CreateObjTrace( - Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_Interp *interp, /* Tcl interpreter */ int level, /* Maximum nesting level */ int flags, /* Flags, see above */ - Tcl_CmdObjTraceProc* proc, /* Trace callback */ + Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ - Tcl_CmdObjTraceDeleteProc* delProc) + Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { register Trace *tracePtr; @@ -2186,8 +2191,9 @@ Tcl_CreateTrace( * command. */ ClientData clientData) /* Arbitrary value word to pass to proc. */ { - StringTraceData* data; - data = (StringTraceData *) ckalloc(sizeof(*data)); + StringTraceData *data = (StringTraceData *) + ckalloc(sizeof(StringTraceData)); + data->clientData = clientData; data->proc = proc; return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc, @@ -2213,16 +2219,16 @@ Tcl_CreateTrace( static int StringTraceProc( ClientData clientData, - Tcl_Interp* interp, + Tcl_Interp *interp, int level, - CONST char* command, + const char *command, Tcl_Command commandInfo, int objc, - Tcl_Obj *CONST *objv) + Tcl_Obj *const *objv) { - StringTraceData* data = (StringTraceData*) clientData; - Command* cmdPtr = (Command*) commandInfo; - CONST char** argv; /* Args to pass to string trace proc */ + StringTraceData *data = (StringTraceData *) clientData; + Command *cmdPtr = (Command *) commandInfo; + const char **argv; /* Args to pass to string trace proc */ int i; /* @@ -2230,8 +2236,8 @@ StringTraceProc( * which uses strings for everything. */ - argv = (CONST char **) TclStackAlloc(interp, - (unsigned) ((objc + 1) * sizeof(CONST char *))); + argv = (const char **) TclStackAlloc(interp, + (unsigned) ((objc + 1) * sizeof(const char *))); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } @@ -2245,7 +2251,7 @@ StringTraceProc( (data->proc)(data->clientData, interp, level, (char *) command, cmdPtr->proc, cmdPtr->clientData, objc, argv); - TclStackFree(interp, (void *)argv); + TclStackFree(interp, (void *) argv); return TCL_OK; } @@ -2360,7 +2366,7 @@ Tcl_DeleteTrace( * Delete the trace object. */ - Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC); + Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC); } /* @@ -2384,7 +2390,7 @@ Tcl_DeleteTrace( Var * TclVarTraceExists( Tcl_Interp *interp, /* The interpreter */ - CONST char *varName) /* The variable name */ + const char *varName) /* The variable name */ { Var *varPtr; Var *arrayPtr; @@ -2462,7 +2468,9 @@ TclObjCallVarTraces( int leaveErrMsg, /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ - int index) + int index) /* Index into the local variable table of the + * variable, or -1. Only used when part1Ptr is + * NULL. */ { char *part1, *part2; @@ -2471,8 +2479,9 @@ TclObjCallVarTraces( } part1 = TclGetString(part1Ptr); part2 = part2Ptr? TclGetString(part2Ptr) : NULL; - - return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); + + return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, + leaveErrMsg); } int @@ -2482,8 +2491,8 @@ TclCallVarTraces( * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ - CONST char *part1, - CONST char *part2, /* Variable's two-part name. */ + const char *part1, + const char *part2, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ @@ -2494,7 +2503,7 @@ TclCallVarTraces( register VarTrace *tracePtr; ActiveVarTrace active; char *result; - CONST char *openParen, *p; + const char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; @@ -2502,7 +2511,7 @@ TclCallVarTraces( Tcl_InterpState state = NULL; Tcl_HashEntry *hPtr; int traceflags = flags & VAR_ALL_TRACES; - + /* * If there are already similar trace functions active for the variable, * don't call them again. @@ -2568,9 +2577,9 @@ TclCallVarTraces( active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; Tcl_Preserve((ClientData) iPtr); - if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) { - hPtr = Tcl_FindHashEntry(&iPtr->varTraces, - (char *) arrayPtr); + if (arrayPtr && !TclIsVarTraceActive(arrayPtr) + && (arrayPtr->flags & traceflags)) { + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr); active.varPtr = arrayPtr; for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { @@ -2615,8 +2624,7 @@ TclCallVarTraces( } active.varPtr = varPtr; if (varPtr->flags & traceflags) { - hPtr = Tcl_FindHashEntry(&iPtr->varTraces, - (char *) varPtr); + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; @@ -2637,7 +2645,7 @@ TclCallVarTraces( /* * Ignore errors in unset traces. */ - + DisposeTraceResult(tracePtr->flags, result); } else { disposeFlags = tracePtr->flags; @@ -2659,7 +2667,7 @@ TclCallVarTraces( done: if (code == TCL_ERROR) { if (leaveErrMsg) { - CONST char *type = ""; + const char *type = ""; Tcl_Obj *options = Tcl_GetReturnOptions((Tcl_Interp *)iPtr, code); Tcl_Obj *errorInfoKey, *errorInfo; @@ -2787,7 +2795,7 @@ DisposeTraceResult( void Tcl_UntraceVar( Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *varName, /* Name of variable; may end with "(index)" to + const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, @@ -2819,8 +2827,8 @@ Tcl_UntraceVar( void Tcl_UntraceVar2( Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *part1, /* Name of variable or array. */ - CONST char *part2, /* Name of element within array; NULL means + const char *part1, /* Name of variable or array. */ + const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed collection of bits describing current @@ -2904,8 +2912,8 @@ Tcl_UntraceVar2( tracePtr = tracePtr->nextPtr) { allFlags |= tracePtr->flags; } - - updateFlags: + + updateFlags: varPtr->flags &= ~VAR_ALL_TRACES; if (allFlags & VAR_ALL_TRACES) { varPtr->flags |= (allFlags & VAR_ALL_TRACES); @@ -2914,6 +2922,7 @@ Tcl_UntraceVar2( * If this is the last trace on the variable, and the variable is * unset and unused, then free up the variable. */ + TclCleanupVar(varPtr, NULL); } } @@ -2944,7 +2953,7 @@ Tcl_UntraceVar2( ClientData Tcl_VarTraceInfo( Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *varName, /* Name of variable; may end with "(index)" to + const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ @@ -2978,8 +2987,8 @@ Tcl_VarTraceInfo( ClientData Tcl_VarTraceInfo2( Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *part1, /* Name of variable or array. */ - CONST char *part2, /* Name of element within array; NULL means + const char *part1, /* Name of variable or array. */ + const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, @@ -3055,7 +3064,7 @@ int Tcl_TraceVar( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ - CONST char *varName, /* Name of variable; may end with "(index)" to + const char *varName, /* Name of variable; may end with "(index)" to * signify an array reference. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -3093,8 +3102,8 @@ int Tcl_TraceVar2( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ - CONST char *part1, /* Name of scalar variable or array. */ - CONST char *part2, /* Name of element within array; NULL means + const char *part1, /* Name of scalar variable or array. */ + const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ int flags, /* OR-ed collection of bits, including any of @@ -3146,8 +3155,8 @@ static int TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ - CONST char *part1, /* Name of scalar variable or array. */ - CONST char *part2, /* Name of element within array; NULL means + const char *part1, /* Name of scalar variable or array. */ + const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ register VarTrace *tracePtr)/* Structure containing flags, traceProc and @@ -3159,9 +3168,8 @@ TraceVarEx( { Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; - int flagMask; + int flagMask, isNew; Tcl_HashEntry *hPtr; - int new; /* * We strip 'flags' down to just the parts which are relevant to @@ -3199,15 +3207,18 @@ TraceVarEx( #endif tracePtr->flags = tracePtr->flags & flagMask; - hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, - (char *) varPtr, &new); - if (new) { + hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew); + if (isNew) { tracePtr->nextPtr = NULL; } else { tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, (char *) tracePtr); + /* + * Mark the variable as traced so we know to call them. + */ + varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES); return TCL_OK; diff --git a/generic/tclVar.c b/generic/tclVar.c index 02c049b..ba33a1c 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.155 2007/11/11 19:32:17 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.156 2007/11/15 09:40:00 dkf Exp $ */ #include "tclInt.h" @@ -148,8 +148,9 @@ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags); -static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, Tcl_Obj *namePtr, - Tcl_Namespace *contextNsPtr, int flags); +static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, + Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr, + int flags); static int ObjMakeUpvar(Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, const char *otherP2, const int otherFlags, @@ -245,11 +246,11 @@ Tcl_ObjType tclArraySearchType = { "array search", NULL, NULL, NULL, SetArraySearchObj }; - + Var * TclVarHashCreateVar( TclVarHashTable *tablePtr, - const char *key, + const char *key, int *newPtr) { Tcl_Obj *keyPtr; @@ -400,7 +401,7 @@ TclLookupVar( /* *---------------------------------------------------------------------- * - * TclObjLookupVar -- + * TclObjLookupVar, TclObjLookupVarEx -- * * This function is used by virtually all of the variable code to locate * a variable given its name(s). The parsing into array/element @@ -483,14 +484,27 @@ TclObjLookupVar( Var * TclObjLookupVarEx( - Tcl_Interp *interp, - Tcl_Obj *part1Ptr, - Tcl_Obj *part2Ptr, - int flags, - const char *msg, - const int createPart1, - const int createPart2, - Var **arrayPtrPtr) + Tcl_Interp *interp, /* Interpreter to use for lookup. */ + Tcl_Obj *part1Ptr, /* If part2Ptr isn't NULL, this is the name of + * an array. Otherwise, this is a full + * variable name that could include a + * parenthesized array element. */ + Tcl_Obj *part2Ptr, /* Name of element within array, or NULL. */ + int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * and TCL_LEAVE_ERR_MSG bits matter. */ + const char *msg, /* Verb to use in error messages, e.g. "read" + * or "set". Only needed if TCL_LEAVE_ERR_MSG + * is set in flags. */ + const int createPart1, /* If 1, create hash table entry for part 1 of + * name, if it doesn't already exist. If 0, + * return error if it doesn't exist. */ + const int createPart2, /* If 1, create hash table entry for part 2 of + * name, if it doesn't already exist. If 0, + * return error if it doesn't exist. */ + Var **arrayPtrPtr) /* If the name refers to an element of an + * array, *arrayPtrPtr gets filled in with + * address of array variable. Otherwise this + * is set to NULL. */ { Interp *iPtr = (Interp *) interp; register Var *varPtr; /* Points to the variable's in-frame Var @@ -522,8 +536,7 @@ TclObjLookupVarEx( if (typePtr == &localVarNameType) { int localIndex; - localVarNameTypeHandling: - + localVarNameTypeHandling: localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value; if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) @@ -532,7 +545,8 @@ TclObjLookupVarEx( * Use the cached index if the names coincide. */ - Tcl_Obj *namePtr = (Tcl_Obj *) part1Ptr->internalRep.ptrAndLongRep.ptr; + Tcl_Obj *namePtr = (Tcl_Obj *) + part1Ptr->internalRep.ptrAndLongRep.ptr; Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex); if ((!namePtr && (checkNamePtr == part1Ptr)) || @@ -711,8 +725,10 @@ TclObjLookupVarEx( part1Ptr->typePtr = &localVarNameType; if (part1Ptr != localName(iPtr->varFramePtr, index)) { - part1Ptr->internalRep.ptrAndLongRep.ptr = localName(iPtr->varFramePtr, index); - Tcl_IncrRefCount((Tcl_Obj *)part1Ptr->internalRep.ptrAndLongRep.ptr); + part1Ptr->internalRep.ptrAndLongRep.ptr = + localName(iPtr->varFramePtr, index); + Tcl_IncrRefCount((Tcl_Obj *) + part1Ptr->internalRep.ptrAndLongRep.ptr); } else { part1Ptr->internalRep.ptrAndLongRep.ptr = NULL; } @@ -919,11 +935,10 @@ TclLookupSimpleVar( || !HasLocalVars(varFramePtr) || (strstr(varName, "::") != NULL)) { const char *tail; - int lookGlobal; - - lookGlobal = (flags & TCL_GLOBAL_ONLY) + int lookGlobal = (flags & TCL_GLOBAL_ONLY) || (cxtNsPtr == iPtr->globalNsPtr) || ((*varName == ':') && (*(varName+1) == ':')); + if (lookGlobal) { *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; @@ -942,7 +957,8 @@ TclLookupSimpleVar( */ varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr, - (Tcl_Namespace *) cxtNsPtr, (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG); + (Tcl_Namespace *) cxtNsPtr, + (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG); if (varPtr == NULL) { Tcl_Obj *tailPtr; @@ -952,11 +968,11 @@ TclLookupSimpleVar( if (varNsPtr == NULL) { *errMsgPtr = badNamespace; return NULL; - } - if (tail == NULL) { + } else if (tail == NULL) { *errMsgPtr = missingName; return NULL; - } else if (tail != varName) { + } + if (tail != varName) { tailPtr = Tcl_NewStringObj(tail, -1); } else { tailPtr = varNamePtr; @@ -984,9 +1000,11 @@ TclLookupSimpleVar( Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; for (i=0 ; i<localCt ; i++, objPtrPtr++) { - Tcl_Obj *objPtr = *objPtrPtr; + register Tcl_Obj *objPtr = *objPtrPtr; + if (objPtr) { char *localName = TclGetString(objPtr); + if ((varName[0] == localName[0]) && (strcmp(varName, localName) == 0)) { *indexPtr = i; @@ -1366,7 +1384,9 @@ TclPtrGetVar( * in the array part1. */ const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ - int index) + int index) /* Index into the local variable table of the + * variable, or -1. Only used when part1Ptr is + * NULL. */ { Interp *iPtr = (Interp *) interp; const char *msg; @@ -2011,7 +2031,9 @@ TclPtrIncrObjVar( * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ - int index) + int index) /* Index into the local variable table of the + * variable, or -1. Only used when part1Ptr is + * NULL. */ { register Tcl_Obj *varValuePtr, *newValuePtr = NULL; int duplicated, code; @@ -2322,7 +2344,8 @@ UnsetVarStruct( dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar, part1Ptr, part2Ptr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))| TCL_TRACE_UNSETS, + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, -1); if (tPtr) { Tcl_DeleteHashEntry(tPtr); @@ -4205,11 +4228,11 @@ ParseSearchId( * optimize this address arithmetic! */ - id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) - - ((char*)NULL)); + id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) - + ((char *) NULL)); string = TclGetString(handleObj); - offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) - - ((char*)NULL)); + offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) - + ((char *) NULL)); /* * This test cannot be placed inside the Tcl_Obj machinery, since it is @@ -4219,9 +4242,7 @@ ParseSearchId( if (strcmp(string+offset, varName) != 0) { Tcl_AppendResult(interp, "search identifier \"", string, "\" isn't for variable \"", varName, "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, - NULL); - return NULL; + goto badLookup; } /* @@ -4235,7 +4256,7 @@ ParseSearchId( if (varPtr->flags & VAR_SEARCH_ACTIVE) { Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr); + Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr); for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL; searchPtr = searchPtr->nextPtr) { @@ -4245,6 +4266,7 @@ ParseSearchId( } } Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL); + badLookup: Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL); return NULL; } @@ -4610,11 +4632,13 @@ TclObjVarErrMsg( const char *operation, /* String describing operation that failed, * e.g. "read", "set", or "unset". */ const char *reason, /* String describing why operation failed. */ - int index) + int index) /* Index into the local variable table of the + * variable, or -1. Only used when part1Ptr is + * NULL. */ { Tcl_ResetResult(interp); if (!part1Ptr) { - part1Ptr = localName(((Interp*)interp)->varFramePtr, index); + part1Ptr = localName(((Interp *)interp)->varFramePtr, index); } Tcl_AppendResult(interp, "can't ", operation, " \"", TclGetString(part1Ptr), NULL); @@ -4685,8 +4709,9 @@ DupLocalVarName( } dupPtr->internalRep.ptrAndLongRep.ptr = namePtr; Tcl_IncrRefCount(namePtr); - - dupPtr->internalRep.ptrAndLongRep.value = srcPtr->internalRep.ptrAndLongRep.value; + + dupPtr->internalRep.ptrAndLongRep.value = + srcPtr->internalRep.ptrAndLongRep.value; dupPtr->typePtr = &localVarNameType; } @@ -4894,7 +4919,7 @@ ObjFindNamespaceVar( Tcl_Var var; Tcl_Obj *simpleNamePtr; char *name = TclGetString(namePtr); - + /* * If this namespace has a variable resolver, then give it first crack at * the variable resolution. It may return a Tcl_Var value, it may signal @@ -4955,7 +4980,7 @@ ObjFindNamespaceVar( } else { simpleNamePtr = namePtr; } - + for (search = 0; (search < 2) && (varPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr); @@ -4964,13 +4989,12 @@ ObjFindNamespaceVar( if (simpleName != name) { Tcl_DecrRefCount(simpleNamePtr); } - if (varPtr != NULL) { - return (Tcl_Var) varPtr; - } else if (flags & TCL_LEAVE_ERR_MSG) { + if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL); } - return (Tcl_Var) NULL; + return (Tcl_Var) varPtr; } /* @@ -5489,8 +5513,8 @@ CompareVarKeys( } /* - * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being - * in a register. + * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a + * register. */ p1 = TclGetString(objPtr1); @@ -5540,7 +5564,7 @@ HashVarKey( * character's bits hang around in the low-order bits of the hash value * for ever, plus they spread fairly rapidly up to the high-order bits * to fill out the hash value. This seems works well both for decimal - * and *non-decimal strings. + * and non-decimal strings. */ for (i=0 ; i<length ; i++) { |