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; +}  | 
