diff options
author | welch <welch> | 1999-08-10 02:42:12 (GMT) |
---|---|---|
committer | welch <welch> | 1999-08-10 02:42:12 (GMT) |
commit | 3a26c6d4498ad6fad866d54c7b23cb221fe21898 (patch) | |
tree | 17f7359546123767d03dd5cbd27b6934f1879b10 /generic/tclVar.c | |
parent | 26903290462f20550bb1d7e596008b2e8f1f723e (diff) | |
download | tcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.zip tcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.tar.gz tcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.tar.bz2 |
1 Added use of Tcl_GetAllocMutex to tclAlloc.c and tclCkalloc.c so they
can be linked against alternate thread packages.
2 Added Tcl_GetChannelNames to tclIO.c
3 Added TclVarTraceExists hook so "info exists" triggers read traces
exactly like it did in Tcl 7.6
4 Stubs table changes to reflect new internal and external APIs
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r-- | generic/tclVar.c | 66 |
1 files changed, 65 insertions, 1 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 2dc867d..67a5cab 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -14,7 +14,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.11 1999/07/22 21:50:54 redman Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.12 1999/08/10 02:42:14 welch Exp $ */ #include "tclInt.h" @@ -4668,3 +4668,67 @@ VarErrMsg(interp, part1, part2, operation, reason) } Tcl_AppendResult(interp, "\": ", reason, (char *) NULL); } + + +/* + *---------------------------------------------------------------------- + * + * TclTraceVarExists -- + * + * This is called from info exists. We need to trigger read + * and/or array traces because they may end up creating a + * variable that doesn't currently exist. + * + * Results: + * A pointer to the Var structure, or NULL. + * + * Side effects: + * May fill in error messages in the interp. + * + *---------------------------------------------------------------------- + */ + +Var * +TclVarTraceExists(interp, varName) + Tcl_Interp *interp; /* The interpreter */ + char *varName; /* The variable name */ +{ + Var *varPtr; + Var *arrayPtr; + char *msg; + + /* + * The choice of "create" flag values is delicate here, and + * matches the semantics of GetVar. Things are still not perfect, + * however, because if you do "info exists x" you get a varPtr + * and therefore trigger traces. However, if you do + * "info exists x(i)", then you only get a varPtr if x is already + * known to be an array. Otherwise you get NULL, and no trace + * is triggered. This matches Tcl 7.6 semantics. + */ + + varPtr = TclLookupVar(interp, varName, (char *) NULL, + 0, "access", + /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); + if (varPtr == NULL) { + return NULL; + } + if ((varPtr != NULL) && + ((varPtr->tracePtr != NULL) + || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { + msg = CallTraces((Interp *)interp, arrayPtr, varPtr, varName, + (char *) NULL, TCL_TRACE_READS); + if (msg != NULL) { + /* + * If the variable doesn't exist anymore and no-one's using + * it, then free up the relevant structures and hash table entries. + */ + + if (TclIsVarUndefined(varPtr)) { + CleanupVar(varPtr, arrayPtr); + } + return NULL; + } + } + return varPtr; +} |