summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
authorwelch <welch>1999-08-10 02:42:12 (GMT)
committerwelch <welch>1999-08-10 02:42:12 (GMT)
commit3a26c6d4498ad6fad866d54c7b23cb221fe21898 (patch)
tree17f7359546123767d03dd5cbd27b6934f1879b10 /generic/tclVar.c
parent26903290462f20550bb1d7e596008b2e8f1f723e (diff)
downloadtcl-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.c66
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;
+}