diff options
| -rw-r--r-- | generic/tclVar.c | 2715 |
1 files changed, 1355 insertions, 1360 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 58de446..e2d3bf9 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -1,8 +1,8 @@ -/* +/* * tclVar.c -- * - * This file contains routines that implement Tcl variables - * (both scalars and arrays). + * This file contains routines that implement Tcl variables (both scalars + * and arrays). * * The implementation of arrays is modelled after an initial * implementation by Mark Diekhans and Karl Lehenbauer. @@ -12,17 +12,17 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.107 2005/06/07 21:46:19 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.108 2005/07/05 14:19:10 dkf Exp $ */ #include "tclInt.h" /* - * The strings below are used to indicate what went wrong when a - * variable access is denied. + * The strings below are used to indicate what went wrong when a variable + * access is denied. */ static CONST char *noSuchVar = "no such variable"; @@ -30,12 +30,13 @@ static CONST char *isArray = "variable is array"; static CONST char *needArray = "variable isn't array"; static CONST char *noSuchElement = "no such element in array"; static CONST char *danglingElement = - "upvar refers to element in deleted array"; -static CONST char *danglingVar = - "upvar refers to variable in deleted namespace"; + "upvar refers to element in deleted array"; +static CONST char *danglingVar = + "upvar refers to variable in deleted namespace"; static CONST char *badNamespace = "parent namespace doesn't exist"; static CONST char *missingName = "missing variable name"; -static CONST char *isArrayElement = "name refers to an element in an array"; +static CONST char *isArrayElement = + "name refers to an element in an array"; /* * Forward references to procedures defined later in this file: @@ -44,10 +45,10 @@ static CONST char *isArrayElement = "name refers to an element in an array"; static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr)); static void DeleteArray _ANSI_ARGS_((Interp *iPtr, CONST char *arrayName, Var *varPtr, int flags)); -static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, - CallFrame *framePtr, Tcl_Obj *otherP1Ptr, - CONST char *otherP2, CONST int otherFlags, - CONST char *myName, int myFlags, int index)); +static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, + CallFrame *framePtr, Tcl_Obj *otherP1Ptr, + CONST char *otherP2, CONST int otherFlags, + CONST char *myName, int myFlags, int index)); static Var * NewVar _ANSI_ARGS_((void)); static ArraySearch * ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, @@ -56,8 +57,8 @@ static int SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* - * Functions defined in this file that may be exported in the future - * for use by the bytecode compiler and engine or to the public interface. + * Functions defined in this file that may be exported in the future for use + * by the bytecode compiler and engine or to the public interface. */ Var * TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp, @@ -77,21 +78,18 @@ static Tcl_SetFromAnyProc PanicOnSetVarName; /* * Types of Tcl_Objs used to cache variable lookups. * - * * localVarName - INTERNALREP DEFINITION: - * longValue = index into locals table + * longValue: index into locals table * * nsVarName - INTERNALREP DEFINITION: - * twoPtrValue.ptr1: pointer to the namespace containing the - * reference - * twoPtrValue.ptr2: pointer to the corresponding Var + * twoPtrValue.ptr1: pointer to the namespace containing the reference + * twoPtrValue.ptr2: pointer to the corresponding Var * * parsedVarName - INTERNALREP DEFINITION: - * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj, - * or NULL if it is a scalar variable - * twoPtrValue.ptr2 = pointer to the element name string - * (owned by this Tcl_Obj), or NULL if - * it is a scalar variable + * twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a + * scalar variable + * twoPtrValue.ptr2: pointer to the element name string (owned by this + * Tcl_Obj), or NULL if it is a scalar variable */ static Tcl_ObjType localVarNameType = { @@ -100,12 +98,12 @@ static Tcl_ObjType localVarNameType = { }; /* - * Caching of namespace variables disabled: no simple way was found to - * avoid interfering with the resolver's idea of variable existence. - * A cached varName may keep a variable's name in the namespace's hash - * table, which is the resolver's criterion for existence (see test - * namespace-17.10). - */ + * Caching of namespace variables disabled: no simple way was found to avoid + * interfering with the resolver's idea of variable existence. A cached + * varName may keep a variable's name in the namespace's hash table, which is + * the resolver's criterion for existence (see test namespace-17.10). + */ + #define ENABLE_NS_VARNAME_CACHING 0 #if ENABLE_NS_VARNAME_CACHING @@ -127,29 +125,28 @@ Tcl_ObjType tclParsedVarNameType = { * Type of Tcl_Objs used to speed up array searches. * * INTERNALREP DEFINITION: - * twoPtrValue.ptr1 = searchIdNumber as offset from (char*)NULL - * twoPtrValue.ptr2 = variableNameStartInString as offset from (char*)NULL + * twoPtrValue.ptr1: searchIdNumber as offset from (char*)NULL + * twoPtrValue.ptr2: variableNameStartInString as offset from (char*)NULL * - * Note that the value stored in ptr2 is the offset into the string of - * the start of the variable name and not the address of the variable - * name itself, as this can be safely copied. + * Note that the value stored in ptr2 is the offset into the string of the + * start of the variable name and not the address of the variable name itself, + * as this can be safely copied. */ + Tcl_ObjType tclArraySearchType = { "array search", NULL, NULL, NULL, SetArraySearchObj }; - /* *---------------------------------------------------------------------- * * TclLookupVar -- * - * This procedure is used to locate a variable given its name(s). It - * has been mostly superseded by TclObjLookupVar, it is now only used - * by the string-based interfaces. It is kept in tcl8.4 mainly because - * it is in the internal stubs table, so that some extension may be - * calling it. + * This procedure is used to locate a variable given its name(s). It has + * been mostly superseded by TclObjLookupVar, it is now only used by the + * string-based interfaces. It is kept in tcl8.4 mainly because it is in + * the internal stubs table, so that some extension may be calling it. * * Results: * The return value is a pointer to the variable structure indicated by @@ -163,14 +160,14 @@ Tcl_ObjType tclArraySearchType = { * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and an error message is left in - * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. + * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * - * Note: it's possible for the variable returned to be VAR_UNDEFINED - * even if createPart1 or createPart2 are 1 (these only cause the hash - * table entry or array to be created). For example, the variable might - * be a global that has been unset but is still referenced by a - * procedure, or a variable that has been unset but it only being kept - * in existence (if VAR_UNDEFINED) by a trace. + * Note: it's possible for the variable returned to be VAR_UNDEFINED even + * if createPart1 or createPart2 are 1 (these only cause the hash table + * entry or array to be created). For example, the variable might be a + * global that has been unset but is still referenced by a procedure, or + * a variable that has been unset but it only being kept in existence (if + * VAR_UNDEFINED) by a trace. * * Side effects: * New hashtable entries may be created if createPart1 or createPart2 @@ -178,39 +175,39 @@ Tcl_ObjType tclArraySearchType = { * *---------------------------------------------------------------------- */ + Var * TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, - arrayPtrPtr) + arrayPtrPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - CONST char *part1; /* If part2 isn't NULL, this is the name of - * an array. Otherwise, this - * is a full variable name that could - * include a parenthesized array element. */ + CONST char *part1; /* If part2 isn't NULL, this is the name of an + * array. Otherwise, this is a full variable + * name that could include a parenthesized + * array element. */ CONST char *part2; /* 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. */ - 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. */ - 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. */ + 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. */ + 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. */ + 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. */ + * address of array variable. Otherwise this + * is set to NULL. */ { Var *varPtr; - CONST char *elName; /* Name of array element or NULL; may be - * same as part2, or may be openParen+1. */ - int openParen, closeParen; - /* If this procedure parses a name into - * array and index, these are the offsets to - * the parens around the index. Otherwise - * they are -1. */ + CONST char *elName; /* Name of array element or NULL; may be same + * as part2, or may be openParen+1. */ + int openParen, closeParen; /* If this procedure parses a name into array + * and index, these are the offsets to the + * parens around the index. Otherwise they + * are -1. */ register CONST char *p; CONST char *errMsg = NULL; int index; @@ -225,11 +222,11 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, /* * Parse part1 into array name and index. * Always check if part1 is an array element name and allow it only if - * part2 is not given. - * (if one does not care about creating array elements that can't be used - * from tcl, and prefer slightly better performance, one can put - * the following in an if (part2 == NULL) { ... } block and remove - * the part2's test and error reporting or move that code in array set) + * part2 is not given. (if one does not care about creating array + * elements that can't be used from tcl, and prefer slightly better + * performance, one can put the following in an if (part2 == NULL) { ... } + * block and remove the part2's test and error reporting or move that code + * in array set) */ elName = part2; @@ -265,8 +262,8 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, elName = newVarName + openParen + 1; } - varPtr = TclLookupSimpleVar(interp, part1, flags, - createPart1, &errMsg, &index); + varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, + &errMsg, &index); if (varPtr == NULL) { if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) { TclVarErrMsg(interp, part1, elName, msg, errMsg); @@ -277,7 +274,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, } if (elName != NULL) { *arrayPtrPtr = varPtr; - varPtr = TclLookupArrayElement(interp, part1, elName, flags, + varPtr = TclLookupArrayElement(interp, part1, elName, flags, msg, createPart1, createPart2, varPtr); } } @@ -286,7 +283,6 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, } return varPtr; - #undef VAR_NAME_BUF_SIZE } @@ -295,15 +291,15 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, * * TclObjLookupVar -- * - * This procedure is used by virtually all of the variable code to - * locate a variable given its name(s). The parsing into array/element - * components and (if possible) the lookup results are cached in - * part1Ptr, which is converted to one of the varNameTypes. + * This procedure is used by virtually all of the variable code to locate + * a variable given its name(s). The parsing into array/element + * components and (if possible) the lookup results are cached in + * part1Ptr, which is converted to one of the varNameTypes. * * Results: * The return value is a pointer to the variable structure indicated by - * part1Ptr and part2, or NULL if the variable couldn't be found. If - * the variable is found, *arrayPtrPtr is filled with the address of the + * part1Ptr and part2, or NULL if the variable couldn't be found. If * + * the variable is found, *arrayPtrPtr is filled with the address of the * variable structure for the array that contains the variable (or NULL * if the variable is a scalar). If the variable can't be found and * either createPart1 or createPart2 are 1, a new as-yet-undefined @@ -312,48 +308,48 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and an error message is left in - * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. + * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * - * Note: it's possible for the variable returned to be VAR_UNDEFINED - * even if createPart1 or createPart2 are 1 (these only cause the hash - * table entry or array to be created). For example, the variable might - * be a global that has been unset but is still referenced by a - * procedure, or a variable that has been unset but it only being kept - * in existence (if VAR_UNDEFINED) by a trace. + * Note: it's possible for the variable returned to be VAR_UNDEFINED even + * if createPart1 or createPart2 are 1 (these only cause the hash table + * entry or array to be created). For example, the variable might be a + * global that has been unset but is still referenced by a procedure, or + * a variable that has been unset but it only being kept in existence (if + * VAR_UNDEFINED) by a trace. * * Side effects: * New hashtable entries may be created if createPart1 or createPart2 - * are 1. - * The object part1Ptr is converted to one of localVarNameType, - * tclNsVarNameType or tclParsedVarNameType and caches as much of the - * lookup as it can. + * are 1. The object part1Ptr is converted to one of localVarNameType, + * tclNsVarNameType or tclParsedVarNameType and caches as much of the + * lookup as it can. * *---------------------------------------------------------------------- */ + Var * TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, - arrayPtrPtr) + arrayPtrPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - register Tcl_Obj *part1Ptr; /* If part2 isn't NULL, this is the name - * of an array. Otherwise, this is a full - * variable name that could include a parenthesized + register Tcl_Obj *part1Ptr; /* If part2 isn't NULL, this is the name of an + * array. Otherwise, this is a full variable + * name that could include a parenthesized * array element. */ CONST char *part2; /* Name of element within array, or NULL. */ - int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + 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. */ + 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. */ + * 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 @@ -368,8 +364,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, Namespace *nsPtr; /* - * If part1Ptr is a tclParsedVarNameType, separate it into the - * pre-parsed parts. + * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed + * parts. */ *arrayPtrPtr = NULL; @@ -377,8 +373,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { if (part2 != NULL) { /* - * ERROR: part1Ptr is already an array element, cannot - * specify a part2. + * ERROR: part1Ptr is already an array element, cannot specify + * a part2. */ if (flags & TCL_LEAVE_ERR_MSG) { @@ -393,65 +389,67 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, } parsed = 1; } - part1 = Tcl_GetStringFromObj(part1Ptr, &len1); + part1 = Tcl_GetStringFromObj(part1Ptr, &len1); nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr); if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { goto doParse; } - + if (typePtr == &localVarNameType) { int localIndex = (int) part1Ptr->internalRep.longValue; if ((varFramePtr != NULL) && (varFramePtr->isProcCallFrame & FRAME_IS_PROC) - && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) + && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { /* * use the cached index if the names coincide. */ - + varPtr = &(varFramePtr->compiledLocals[localIndex]); - if ((varPtr->name != NULL) - && (strcmp(part1, varPtr->name) == 0)) { + if ((varPtr->name != NULL) && (strcmp(part1, varPtr->name) == 0)) { goto donePart1; } } goto doneParsing; #if ENABLE_NS_VARNAME_CACHING } else if (typePtr == &tclNsVarNameType) { - Namespace *cachedNsPtr; int useGlobal, useReference; - + Namespace *cachedNsPtr = (Namespace *) + part1Ptr->internalRep.twoPtrValue.ptr1; varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2; - cachedNsPtr = (Namespace *) part1Ptr->internalRep.twoPtrValue.ptr1; - useGlobal = (cachedNsPtr == iPtr->globalNsPtr) - && ((flags & TCL_GLOBAL_ONLY) - || ((*part1 == ':') && (*(part1+1) == ':')) - || (varFramePtr == NULL) - || (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC) - && (nsPtr == iPtr->globalNsPtr))); - useReference = useGlobal || ((cachedNsPtr == nsPtr) - && ((flags & TCL_NAMESPACE_ONLY) - || (varFramePtr - && !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) - && !(flags & TCL_GLOBAL_ONLY) - /* careful: an undefined ns variable could - * be hiding a valid global reference. */ - && !TclIsVarUndefined(varPtr)))); + + useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && ( + (flags & TCL_GLOBAL_ONLY) || + (*part1==':' && *(part1+1)==':') || + (varFramePtr == NULL) || + (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC) + && (nsPtr == iPtr->globalNsPtr))); + + useReference = useGlobal || ((cachedNsPtr == nsPtr) && ( + (flags & TCL_NAMESPACE_ONLY) || + (varFramePtr && + !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) && + !(flags & TCL_GLOBAL_ONLY) && + /* Careful: an undefined ns variable could be hiding a valid + * global reference. */ + !TclIsVarUndefined(varPtr)))); + if (useReference && (varPtr->hPtr != NULL)) { /* - * A straight global or namespace reference, use it. It isn't - * so simple to deal with 'implicit' namespace references, i.e., - * those where the reference could be to either a namespace - * or a global variable. Those we lookup again. + * A straight global or namespace reference, use it. It isn't so + * simple to deal with 'implicit' namespace references, i.e., + * those where the reference could be to either a namespace or a + * global variable. Those we lookup again. * * If (varPtr->hPtr == NULL), this might be a reference to a * variable in a deleted namespace, kept alive by e.g. part1Ptr. * We could conceivably be so unlucky that a new namespace was - * created at the same address as the deleted one, so to be - * safe we test for a valid hPtr. + * created at the same address as the deleted one, so to be safe + * we test for a valid hPtr. */ + goto donePart1; } goto doneParsing; @@ -463,8 +461,10 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, /* * part1Ptr is possibly an unparsed array element. */ + register int i; char *newPart2; + len2 = -1; for (i = 0; i < len1; i++) { if (*(part1 + i) == '(') { @@ -472,11 +472,11 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, if (flags & TCL_LEAVE_ERR_MSG) { TclVarErrMsg(interp, part1, part2, msg, needArray); } - } + } /* - * part1Ptr points to an array element; first copy - * the element name to a new string part2. + * part1Ptr points to an array element; first copy the element + * name to a new string part2. */ part2 = part1 + i + 1; @@ -489,8 +489,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, part2 = newPart2; /* - * Free the internal rep of the original part1Ptr, now - * renamed objPtr, and set it to tclParsedVarNameType. + * Free the internal rep of the original part1Ptr, now renamed + * objPtr, and set it to tclParsedVarNameType. */ objPtr = part1Ptr; @@ -498,17 +498,17 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, objPtr->typePtr = &tclParsedVarNameType; /* - * Define a new string object to hold the new part1Ptr, i.e., + * Define a new string object to hold the new part1Ptr, i.e., * the array name. Set the internal rep of objPtr, reset - * typePtr and part1 to contain the references to the - * array name. + * typePtr and part1 to contain the references to the array + * name. */ TclNewStringObj(part1Ptr, part1, len1); Tcl_IncrRefCount(part1Ptr); objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr; - objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2; + objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2; typePtr = part1Ptr->typePtr; part1 = TclGetString(part1Ptr); @@ -516,18 +516,18 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, } } } - - doneParsing: + + doneParsing: /* - * part1Ptr is not an array element; look it up, and convert - * it to one of the cached types if possible. + * part1Ptr is not an array element; look it up, and convert it to one of + * the cached types if possible. */ TclFreeIntRep(part1Ptr); part1Ptr->typePtr = NULL; - varPtr = TclLookupSimpleVar(interp, part1, flags, - createPart1, &errMsg, &index); + varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, + &errMsg, &index); if (varPtr == NULL) { if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) { TclVarErrMsg(interp, part1, part2, msg, errMsg); @@ -540,7 +540,7 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, */ if (index >= 0) { - /* + /* * An indexed local variable. */ @@ -551,8 +551,9 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, /* * A cacheable namespace or global variable. */ + Namespace *nsPtr; - + nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr); varPtr->refCount++; part1Ptr->typePtr = &tclNsVarNameType; @@ -563,17 +564,18 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, /* * At least mark part1Ptr as already parsed. */ + part1Ptr->typePtr = &tclParsedVarNameType; part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; part1Ptr->internalRep.twoPtrValue.ptr2 = NULL; } - - donePart1: + + donePart1: #if 0 if (varPtr == NULL) { if (flags & TCL_LEAVE_ERR_MSG) { part1 = TclGetString(part1Ptr); - TclVarErrMsg(interp, part1, part2, msg, + TclVarErrMsg(interp, part1, part2, msg, "Cached variable reference is NULL."); } return NULL; @@ -590,18 +592,18 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, part1 = TclGetString(part1Ptr); *arrayPtrPtr = varPtr; - varPtr = TclLookupArrayElement(interp, part1, part2, - flags, msg, createPart1, createPart2, varPtr); + varPtr = TclLookupArrayElement(interp, part1, part2, flags, msg, + createPart1, createPart2, varPtr); } return varPtr; } /* * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for + * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for * upvar (or similar) purposes, with slightly different rules: * - Bug #696893 - variable is either proc-local or in the current - * namespace; never follow the second (global) resolution path + * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers * * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag @@ -615,35 +617,36 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, * * TclLookupSimpleVar -- * - * This procedure is used by to locate a simple variable (i.e., not - * an array element) given its name. + * This procedure is used by to locate a simple variable (i.e., not an + * array element) given its name. * * Results: * The return value is a pointer to the variable structure indicated by - * varName, or NULL if the variable couldn't be found. If the variable - * can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED) - * variable structure is created, entered into a hash table, and returned. - * - * If the current CallFrame corresponds to a proc and the variable found is - * one of the compiledLocals, its index is placed in *indexPtr. Otherwise, - * *indexPtr will be set to (according to the needs of TclObjLookupVar): - * -1 a global reference - * -2 a reference to a namespace variable - * -3 a non-cachable reference, i.e., one of: - * . non-indexed local var - * . a reference of unknown origin; - * . resolution by a namespace or interp resolver + * varName, or NULL if the variable couldn't be found. If the variable + * can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED) + * variable structure is created, entered into a hash table, and + * returned. + * + * If the current CallFrame corresponds to a proc and the variable found + * is one of the compiledLocals, its index is placed in *indexPtr. + * Otherwise, *indexPtr will be set to (according to the needs of + * TclObjLookupVar): + * -1 a global reference + * -2 a reference to a namespace variable + * -3 a non-cachable reference, i.e., one of: + * . non-indexed local var + * . a reference of unknown origin; + * . resolution by a namespace or interp resolver * * If the variable isn't found and creation wasn't specified, or some * other error occurs, NULL is returned and the corresponding error - * message is left in *errMsgPtr. + * message is left in *errMsgPtr. * - * Note: it's possible for the variable returned to be VAR_UNDEFINED - * even if create is 1 (this only causes the hash table entry to be - * created). For example, the variable might be a global that has been - * unset but is still referenced by a procedure, or a variable that has - * been unset but it only being kept in existence (if VAR_UNDEFINED) by - * a trace. + * Note: it's possible for the variable returned to be VAR_UNDEFINED even + * if create is 1 (this only causes the hash table entry to be created). + * For example, the variable might be a global that has been unset but is + * still referenced by a procedure, or a variable that has been unset but + * it only being kept in existence (if VAR_UNDEFINED) by a trace. * * Side effects: * A new hashtable entry may be created if create is 1. @@ -654,26 +657,26 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, Var * TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - CONST char *varName; /* This is a simple variable name that could - * representa scalar or an array. */ - int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits + CONST char *varName; /* This is a simple variable name that could + * represent a scalar or an array. */ + int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits * matter. */ CONST int create; /* If 1, create hash table entry for varname, - * if it doesn't already exist. If 0, return + * if it doesn't already exist. If 0, return * error if it doesn't exist. */ CONST char **errMsgPtr; int *indexPtr; -{ +{ Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; /* Points to the procedure call frame whose - * variables are currently in use. Same as - * the current procedure's frame, if any, - * unless an "uplevel" is executing. */ + * variables are currently in use. Same as the + * current procedure's frame, if any, unless + * an "uplevel" is executing. */ Tcl_HashTable *tablePtr; /* Points to the hashtable, if any, in which * to look up the variable. */ - Tcl_Var var; /* Used to search for global names. */ + Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; @@ -686,59 +689,57 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) *indexPtr = -3; if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) { - cxtNsPtr = iPtr->globalNsPtr; + cxtNsPtr = iPtr->globalNsPtr; } else { - cxtNsPtr = iPtr->varFramePtr->nsPtr; + cxtNsPtr = iPtr->varFramePtr->nsPtr; } /* - * 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 to continue onward, or it may signal - * an error. + * 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 + * to continue onward, or it may signal an error. */ - if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) + if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) && !(flags & LOOKUP_FOR_UPVAR)) { - resPtr = iPtr->resolverPtr; - if (cxtNsPtr->varResProc) { - result = (*cxtNsPtr->varResProc)(interp, varName, + resPtr = iPtr->resolverPtr; + if (cxtNsPtr->varResProc) { + result = (*cxtNsPtr->varResProc)(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); - } else { - result = TCL_CONTINUE; - } + } else { + result = TCL_CONTINUE; + } - while (result == TCL_CONTINUE && resPtr) { - if (resPtr->varResProc) { - result = (*resPtr->varResProc)(interp, varName, + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->varResProc) { + result = (*resPtr->varResProc)(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); - } - resPtr = resPtr->nextPtr; - } - - if (result == TCL_OK) { - varPtr = (Var *) var; - return varPtr; - } else if (result != TCL_CONTINUE) { + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return (Var *) var; + } else if (result != TCL_CONTINUE) { return NULL; - } + } } /* * Look up varName. Look it up as either a namespace variable or as a - * local variable in a procedure call frame (varFramePtr). - * Interpret varName as a namespace variable if: + * local variable in a procedure call frame (varFramePtr). Interpret + * varName as a namespace variable if: * 1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag, * 2) there is no active frame (we're at the global :: scope), - * 3) the active frame was pushed to define the namespace context - * for a "namespace eval" or "namespace inscope" command, + * 3) the active frame was pushed to define the namespace context for a + * "namespace eval" or "namespace inscope" command, * 4) the name has namespace qualifiers ("::"s). - * Otherwise, if varName is a local variable, search first in the - * frame's array of compiler-allocated local variables, then in its - * hashtable for runtime-created local variables. + * Otherwise, if varName is a local variable, search first in the frame's + * array of compiler-allocated local variables, then in its hashtable for + * runtime-created local variables. * - * If create and the variable isn't found, create the variable and, - * if necessary, create varFramePtr's local var hashtable. + * If create and the variable isn't found, create the variable and, if + * necessary, create varFramePtr's local var hashtable. */ if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0) @@ -747,13 +748,14 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) || (strstr(varName, "::") != NULL)) { CONST char *tail; int lookGlobal; - - lookGlobal = (flags & TCL_GLOBAL_ONLY) - || (cxtNsPtr == iPtr->globalNsPtr) - || ((*varName == ':') && (*(varName+1) == ':')); + + lookGlobal = (flags & TCL_GLOBAL_ONLY) + || (cxtNsPtr == iPtr->globalNsPtr) + || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; - flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR); + flags = (flags | TCL_GLOBAL_ONLY) & + ~(TCL_NAMESPACE_ONLY | LOOKUP_FOR_UPVAR); } else { if (flags & LOOKUP_FOR_UPVAR) { flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR; @@ -761,22 +763,22 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) if (flags & TCL_NAMESPACE_ONLY) { *indexPtr = -2; } - } + } - /* - * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, - * or otherwise generate our own error! + /* + * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or + * otherwise generate our own error! */ var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags & ~TCL_LEAVE_ERR_MSG); if (var != (Tcl_Var) NULL) { - varPtr = (Var *) var; - } + varPtr = (Var *) var; + } if (varPtr == NULL) { - if (create) { /* var wasn't found so create it */ + if (create) { /* var wasn't found so create it */ TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail); if (varNsPtr == NULL) { @@ -795,9 +797,10 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) if (lookGlobal) { /* * The variable was created starting from the global - * namespace: a global reference is returned even if - * it wasn't explicitly requested. + * namespace: a global reference is returned even if it + * wasn't explicitly requested. */ + *indexPtr = -1; } else { *indexPtr = -2; @@ -813,13 +816,13 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) CompiledLocal *localPtr = procPtr->firstLocalPtr; Var *localVarPtr = varFramePtr->compiledLocals; int varNameLen = strlen(varName); - + for (i = 0; i < localCt; i++) { if (!TclIsVarTemporary(localPtr)) { register char *localName = localVarPtr->name; if ((varName[0] == localName[0]) - && (varNameLen == localPtr->nameLength) - && (strcmp(varName, localName) == 0)) { + && (varNameLen == localPtr->nameLength) + && (strcmp(varName, localName) == 0)) { *indexPtr = i; return localVarPtr; } @@ -840,7 +843,7 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) varPtr = NewVar(); Tcl_SetHashValue(hPtr, varPtr); varPtr->hPtr = hPtr; - varPtr->nsPtr = NULL; /* a local variable */ + varPtr->nsPtr = NULL; /* a local variable */ } else { varPtr = (Var *) Tcl_GetHashValue(hPtr); } @@ -864,34 +867,34 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) * * TclLookupArrayElement -- * - * This procedure is used to locate a variable which is in an array's - * hashtable given a pointer to the array's Var structure and the - * element's name. + * This procedure is used to locate a variable which is in an array's + * hashtable given a pointer to the array's Var structure and the + * element's name. * * Results: - * The return value is a pointer to the variable structure , or NULL if - * the variable couldn't be found. + * The return value is a pointer to the variable structure , or NULL if + * the variable couldn't be found. * - * If arrayPtr points to a variable that isn't an array and createPart1 - * is 1, the corresponding variable will be converted to an array. - * Otherwise, NULL is returned and an error message is left in - * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. + * If arrayPtr points to a variable that isn't an array and createPart1 + * is 1, the corresponding variable will be converted to an array. + * Otherwise, NULL is returned and an error message is left in the + * interp's result if TCL_LEAVE_ERR_MSG is set in flags. * - * If the variable is not found and createPart2 is 1, the variable is - * created. Otherwise, NULL is returned and an error message is left in + * If the variable is not found and createPart2 is 1, the variable is + * created. Otherwise, NULL is returned and an error message is left in * the interp's result if TCL_LEAVE_ERR_MSG is set in flags. * - * Note: it's possible for the variable returned to be VAR_UNDEFINED - * even if createPart1 or createPart2 are 1 (these only cause the hash - * table entry or array to be created). For example, the variable might - * be a global that has been unset but is still referenced by a - * procedure, or a variable that has been unset but it only being kept - * in existence (if VAR_UNDEFINED) by a trace. + * Note: it's possible for the variable returned to be VAR_UNDEFINED even + * if createPart1 or createPart2 are 1 (these only cause the hash table + * entry or array to be created). For example, the variable might be a + * global that has been unset but is still referenced by a procedure, or + * a variable that has been unset but it only being kept in existence (if + * VAR_UNDEFINED) by a trace. * * Side effects: - * The variable at arrayPtr may be converted to be an array if - * createPart1 is 1. A new hashtable entry may be created if createPart2 - * is 1. + * The variable at arrayPtr may be converted to be an array if + * createPart1 is 1. A new hashtable entry may be created if createPart2 + * is 1. * *---------------------------------------------------------------------- */ @@ -899,28 +902,28 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) Var * TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, createElem, arrayPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - CONST char *arrayName; /* This is the name of the array. */ + CONST char *arrayName; /* This is the name of the array. */ CONST char *elName; /* Name of element within array. */ CONST int flags; /* Only TCL_LEAVE_ERR_MSG bit matters. */ - 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 createArray; /* If 1, transform arrayName to be an array - * if it isn't one yet and the transformation - * is possible. If 0, return error if it - * isn't already an array. */ - CONST int createElem; /* If 1, create hash table entry for the - * element, if it doesn't already exist. If - * 0, return error if it doesn't exist. */ - Var *arrayPtr; /* Pointer to the array's Var structure. */ + 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 createArray; /* If 1, transform arrayName to be an array if + * it isn't one yet and the transformation is + * possible. If 0, return error if it isn't + * already an array. */ + CONST int createElem; /* If 1, create hash table entry for the + * element, if it doesn't already exist. If 0, + * return error if it doesn't exist. */ + Var *arrayPtr; /* Pointer to the array's Var structure. */ { Tcl_HashEntry *hPtr; int new; Var *varPtr; /* - * We're dealing with an array element. Make sure the variable is an - * array and look up the element (create the element if desired). + * We're dealing with an array element. Make sure the variable is an array + * and look up the element (create the element if desired). */ if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) { @@ -935,6 +938,7 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create * Make sure we are not resurrecting a namespace variable from a * deleted namespace! */ + if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) { if (flags & TCL_LEAVE_ERR_MSG) { TclVarErrMsg(interp, arrayName, elName, msg, danglingVar); @@ -944,8 +948,8 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create TclSetVarArray(arrayPtr); TclClearVarUndefined(arrayPtr); - arrayPtr->value.tablePtr = - (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + arrayPtr->value.tablePtr = (Tcl_HashTable *) + ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS); } else if (!TclIsVarArray(arrayPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { @@ -987,9 +991,9 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create * * Results: * The return value points to the current value of varName as a string. - * If the variable is not defined or can't be read because of a clash - * in array usage then a NULL pointer is returned and an error message - * is left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. + * If the variable is not defined or can't be read because of a clash in + * array usage then a NULL pointer is returned and an error message is + * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. * Note: the return value is only valid up until the next change to the * variable; if you depend on the value lasting longer than that, then * make yourself a private copy. @@ -1002,8 +1006,8 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create CONST char * Tcl_GetVar(interp, varName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ CONST char *varName; /* Name of a variable in interp. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG @@ -1017,17 +1021,17 @@ Tcl_GetVar(interp, varName, flags) * * Tcl_GetVar2 -- * - * Return the value of a Tcl variable as a string, given a two-part - * name consisting of array name and element within array. + * Return the value of a Tcl variable as a string, given a two-part name + * consisting of array name and element within array. * * Results: - * The return value points to the current value of the variable given - * by part1 and part2 as a string. If the specified variable doesn't - * exist, or if there is a clash in array usage, then NULL is returned - * and a message will be left in the interp's result if the - * TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid - * up until the next change to the variable; if you depend on the value - * lasting longer than that, then make yourself a private copy. + * The return value points to the current value of the variable given by + * part1 and part2 as a string. If the specified variable doesn't exist, + * or if there is a clash in array usage, then NULL is returned and a + * message will be left in the interp's result if the TCL_LEAVE_ERR_MSG + * flag is set. Note: the return value is only valid up until the next + * change to the variable; if you depend on the value lasting longer than + * that, then make yourself a private copy. * * Side effects: * None. @@ -1037,15 +1041,15 @@ Tcl_GetVar(interp, varName, flags) CONST char * Tcl_GetVar2(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) - * or the name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ + CONST char *part1; /* Name of an array (if part2 is non-NULL) or + * the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG - * bits. */ + * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG * + * bits. */ { Tcl_Obj *objPtr; @@ -1061,8 +1065,8 @@ Tcl_GetVar2(interp, part1, part2, flags) * * Tcl_GetVar2Ex -- * - * Return the value of a Tcl variable as a Tcl object, given a - * two-part name consisting of array name and element within array. + * Return the value of a Tcl variable as a Tcl object, given a two-part + * name consisting of array name and element within array. * * Results: * The return value points to the current object value of the variable @@ -1072,23 +1076,23 @@ Tcl_GetVar2(interp, part1, part2, flags) * TCL_LEAVE_ERR_MSG flag is set. * * Side effects: - * The ref count for the returned object is _not_ incremented to - * reflect the returned reference; if you want to keep a reference to - * the object you must increment its ref count yourself. + * The ref count for the returned object is _not_ incremented to reflect + * the returned reference; if you want to keep a reference to the object + * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetVar2Ex(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) - * or the name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ + CONST char *part1; /* Name of an array (if part2 is non-NULL) or + * the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ - int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, - * and TCL_LEAVE_ERR_MSG bits. */ + int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; @@ -1097,8 +1101,9 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) * because commands like lappend require read traces to trigger for * previously non-existent values. */ + varPtr = TclLookupVar(interp, part1, part2, flags, "read", - /*createPart1*/ (flags & TCL_TRACE_READS), + /*createPart1*/ (flags & TCL_TRACE_READS), /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; @@ -1112,8 +1117,8 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) * * Tcl_ObjGetVar2 -- * - * Return the value of a Tcl variable as a Tcl object, given a - * two-part name consisting of array name and element within array. + * Return the value of a Tcl variable as a Tcl object, given a two-part + * name consisting of array name and element within array. * * Results: * The return value points to the current object value of the variable @@ -1123,20 +1128,20 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) * TCL_LEAVE_ERR_MSG flag is set. * * Side effects: - * The ref count for the returned object is _not_ incremented to - * reflect the returned reference; if you want to keep a reference to - * the object you must increment its ref count yourself. + * The ref count for the returned object is _not_ incremented to reflect + * the returned reference; if you want to keep a reference to the object + * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ - register Tcl_Obj *part1Ptr; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ + register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ @@ -1148,14 +1153,15 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); - + /* * We need a special flag check to see if we want to create part 1, * because commands like lappend require read traces to trigger for * previously non-existent values. */ + varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", - /*createPart1*/ (flags & TCL_TRACE_READS), + /*createPart1*/ (flags & TCL_TRACE_READS), /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; @@ -1169,37 +1175,36 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) * * TclPtrGetVar -- * - * Return the value of a Tcl variable as a Tcl object, given the - * pointers to the variable's (and possibly containing array's) - * VAR structure. + * Return the value of a Tcl variable as a Tcl object, given the pointers + * to the variable's (and possibly containing array's) VAR structure. * * Results: * The return value points to the current object value of the variable - * given by varPtr. If the specified variable doesn't exist, or if there - * is a clash in array usage, then NULL is returned and a message will be - * left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set. + * given by varPtr. If the specified variable doesn't exist, or if there + * is a clash in array usage, then NULL is returned and a message will be + * left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set. * * Side effects: - * The ref count for the returned object is _not_ incremented to - * reflect the returned reference; if you want to keep a reference to - * the object you must increment its ref count yourself. + * The ref count for the returned object is _not_ incremented to reflect + * the returned reference; if you want to keep a reference to the object + * you must increment its ref count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ - register Var *varPtr; /* The variable to be read.*/ - Var *arrayPtr; /* NULL for scalar variables, pointer to - * the containing array otherwise. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) - * or the name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ + register Var *varPtr; /* The variable to be read.*/ + Var *arrayPtr; /* NULL for scalar variables, pointer to the + * containing array otherwise. */ + CONST char *part1; /* Name of an array (if part2 is non-NULL) or + * the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ - CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, - * and TCL_LEAVE_ERR_MSG bits. */ + CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + * TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; CONST char *msg; @@ -1220,14 +1225,14 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) /* * Return the element if it's an existing scalar variable. */ - + if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) { return varPtr->value.objPtr; } - + if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL) - && !TclIsVarUndefined(arrayPtr)) { + && !TclIsVarUndefined(arrayPtr)) { msg = noSuchElement; } else if (TclIsVarArray(varPtr)) { msg = isArray; @@ -1238,11 +1243,11 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) } /* - * An error. If the variable doesn't exist anymore and no-one's using - * it, then free up the relevant structures and hash table entries. + * An error. If the variable doesn't exist anymore and no-one's using it, + * then free up the relevant structures and hash table entries. */ - errorReturn: + errorReturn: if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } @@ -1254,8 +1259,8 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) * * Tcl_SetObjCmd -- * - * This procedure is invoked to process the "set" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "set" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result value. @@ -1269,10 +1274,10 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) /* ARGSUSED */ int Tcl_SetObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - register Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + register Tcl_Interp *interp;/* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *varValueObj; @@ -1284,7 +1289,6 @@ Tcl_SetObjCmd(dummy, interp, objc, objv) Tcl_SetObjResult(interp, varValueObj); return TCL_OK; } else if (objc == 3) { - varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2], TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { @@ -1315,23 +1319,23 @@ Tcl_SetObjCmd(dummy, interp, objc, objv) * variable traces may modify the variable's value. * * Side effects: - * If varName is defined as a local or global variable in interp, - * its value is changed to newValue. If varName isn't currently - * defined, then a new global variable by that name is created. + * If varName is defined as a local or global variable in interp, its + * value is changed to newValue. If varName isn't currently defined, then + * a new global variable by that name is created. * *---------------------------------------------------------------------- */ CONST char * Tcl_SetVar(interp, varName, newValue, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ CONST char *varName; /* Name of a variable in interp. */ CONST char *newValue; /* New value for varName. */ int flags; /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ { return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags); } @@ -1341,57 +1345,56 @@ Tcl_SetVar(interp, varName, newValue, flags) * * Tcl_SetVar2 -- * - * Given a two-part variable name, which may refer either to a - * scalar variable or an element of an array, change the value - * of the variable. If the named scalar or array or element - * doesn't exist then create one. + * Given a two-part variable name, which may refer either to a scalar + * variable or an element of an array, change the value of the variable. + * If the named scalar or array or element doesn't exist then create one. * * Results: * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not - * modify this string. If the write operation was disallowed because an - * array was expected but not found (or vice versa), then NULL is - * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory - * message will be left in the interp's result. Note that the returned - * string may not be the same as newValue; this is because variable - * traces may modify the variable's value. + * representation of the variable's new value. The caller must not modify + * this string. If the write operation was disallowed because an array + * was expected but not found (or vice versa), then NULL is returned; if + * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be + * left in the interp's result. Note that the returned string may not be + * the same as newValue; this is because variable traces may modify the + * variable's value. * * Side effects: - * The value of the given variable is set. If either the array - * or the entry didn't exist then a new one is created. + * The value of the given variable is set. If either the array or the + * entry didn't exist then a new one is created. * *---------------------------------------------------------------------- */ CONST char * Tcl_SetVar2(interp, part1, part2, newValue, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ - CONST char *part1; /* If part2 is NULL, this is name of scalar - * variable. Otherwise it is the name of - * an array. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ + CONST char *part1; /* If part2 is NULL, this is name of scalar + * variable. Otherwise it is the name of an + * array. */ CONST char *part2; /* Name of an element within an array, or * NULL. */ - CONST char *newValue; /* New value for variable. */ - int flags; /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG */ + CONST char *newValue; /* New value for variable. */ + int flags; /* Various flags that tell how to set value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or + * TCL_LEAVE_ERR_MSG */ { register Tcl_Obj *valuePtr; Tcl_Obj *varValuePtr; /* - * Create an object holding the variable's new value and use - * Tcl_SetVar2Ex to actually set the variable. + * Create an object holding the variable's new value and use Tcl_SetVar2Ex + * to actually set the variable. */ valuePtr = Tcl_NewStringObj(newValue, -1); Tcl_IncrRefCount(valuePtr); varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags); - Tcl_DecrRefCount(valuePtr); /* done with the object */ - + TclDecrRefCount(valuePtr); /* done with the object */ + if (varValuePtr == NULL) { return NULL; } @@ -1411,10 +1414,10 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags) * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was - * expected but not found (or vice versa), then NULL is returned; if - * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will - * be left in the interpreter's result. Note that the returned object - * may not be the same one referenced by newValuePtr; this is because + * expected but not found (or vice versa), then NULL is returned; if the + * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be + * left in the interpreter's result. Note that the returned object may + * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: @@ -1423,32 +1426,32 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags) * * The reference count is decremented for any old value of the variable * and incremented for its new value. If the new value for the variable - * is not the same one referenced by newValuePtr (perhaps as a result - * of a variable trace), then newValuePtr's ref count is left unchanged - * by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if - * we are appending it as a string value: that is, if "flags" includes + * is not the same one referenced by newValuePtr (perhaps as a result of + * a variable trace), then newValuePtr's ref count is left unchanged by + * Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if we + * are appending it as a string value: that is, if "flags" includes * TCL_APPEND_VALUE but not TCL_LIST_ELEMENT. * * The reference count for the returned object is _not_ incremented: if - * you want to keep a reference to the object you must increment its - * ref count yourself. + * you want to keep a reference to the object you must increment its ref + * count yourself. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) - * or the name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ + CONST char *part1; /* Name of an array (if part2 is non-NULL) or + * the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr; /* New value for variable. */ int flags; /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */ + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or + * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; @@ -1458,8 +1461,8 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) return NULL; } - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - newValuePtr, flags); + return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, + newValuePtr, flags); } /* @@ -1467,16 +1470,16 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) * * Tcl_ObjSetVar2 -- * - * This function is the same as Tcl_SetVar2Ex above, except the - * variable names are passed in Tcl object instead of strings. + * This function is the same as Tcl_SetVar2Ex above, except the variable + * names are passed in Tcl object instead of strings. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was - * expected but not found (or vice versa), then NULL is returned; if - * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will - * be left in the interpreter's result. Note that the returned object - * may not be the same one referenced by newValuePtr; this is because + * expected but not found (or vice versa), then NULL is returned; if the + * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be + * left in the interpreter's result. Note that the returned object may + * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: @@ -1488,25 +1491,25 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) Tcl_Obj * Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ - register Tcl_Obj *part1Ptr; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ + register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr; /* New value for variable. */ int flags; /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */ + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or + * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; char *part1, *part2; part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); + part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); @@ -1514,8 +1517,8 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) return NULL; } - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - newValuePtr, flags); + return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, + newValuePtr, flags); } /* @@ -1523,17 +1526,17 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) * * TclPtrSetVar -- * - * This function is the same as Tcl_SetVar2Ex above, except that - * it requires pointers to the variable's Var structs in addition - * to the variable names. + * This function is the same as Tcl_SetVar2Ex above, except that it + * requires pointers to the variable's Var structs in addition to the + * variable names. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the * variable. If the write operation was disallowed because an array was - * expected but not found (or vice versa), then NULL is returned; if - * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will - * be left in the interpreter's result. Note that the returned object - * may not be the same one referenced by newValuePtr; this is because + * expected but not found (or vice versa), then NULL is returned; if the + * TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be + * left in the interpreter's result. Note that the returned object may + * not be the same one referenced by newValuePtr; this is because * variable traces may modify the variable's value. * * Side effects: @@ -1545,17 +1548,17 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) Tcl_Obj * TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be looked up. */ register Var *varPtr; Var *arrayPtr; - CONST char *part1; /* Name of an array (if part2 is non-NULL) - * or the name of a variable. */ + CONST char *part1; /* Name of an array (if part2 is non-NULL) or + * the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr; /* New value for variable. */ - CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, - * and TCL_LEAVE_ERR_MSG bits. */ + CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + * TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; @@ -1564,10 +1567,10 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) /* * If the variable is in a hashtable and its hPtr field is NULL, then we - * may have an upvar to an array element where the array was deleted - * or an upvar to a namespace variable whose namespace was deleted. - * Generate an error (allowing the variable to be reset would screw up - * our storage allocation and is meaningless anyway). + * may have an upvar to an array element where the array was deleted or an + * upvar to a namespace variable whose namespace was deleted. Generate an + * error (allowing the variable to be reset would screw up our storage + * allocation and is meaningless anyway). */ if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) { @@ -1593,11 +1596,11 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) } /* - * Invoke any read traces that have been set for the variable if it - * is requested; this is only done in the core when lappending. + * Invoke any read traces that have been set for the variable if it is + * requested; this is only done in the core when lappending. */ - if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) + if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { @@ -1606,11 +1609,10 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) } /* - * Set the variable's new value. If appending, append the new value to - * the variable, either as a list element or as a string. Also, if - * appending, then if the variable's old value is unshared we can modify - * it directly, otherwise we must create a new copy to modify: this is - * "copy on write". + * Set the variable's new value. If appending, append the new value to the + * variable, either as a list element or as a string. Also, if appending, + * then if the variable's old value is unshared we can modify it directly, + * otherwise we must create a new copy to modify: this is "copy on write". */ if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) { @@ -1619,27 +1621,27 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) oldValuePtr = varPtr->value.objPtr; if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { - TclDecrRefCount(oldValuePtr); /* discard old value */ + TclDecrRefCount(oldValuePtr); /* discard old value */ varPtr->value.objPtr = NULL; oldValuePtr = NULL; } - if (flags & TCL_LIST_ELEMENT) { /* append list element */ + if (flags & TCL_LIST_ELEMENT) { /* append list element */ if (oldValuePtr == NULL) { TclNewObj(oldValuePtr); varPtr->value.objPtr = oldValuePtr; - Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } else if (Tcl_IsShared(oldValuePtr)) { varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; - Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { return NULL; } - } else { /* append string */ + } else { /* append string */ /* * We append newValuePtr's bytes but don't change its ref count. */ @@ -1648,25 +1650,25 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); } else { - if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ + if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; - Tcl_IncrRefCount(oldValuePtr); /* since var is ref */ + Tcl_IncrRefCount(oldValuePtr); /* since var is ref */ } Tcl_AppendObjToObj(oldValuePtr, newValuePtr); } } } else if (newValuePtr != oldValuePtr) { /* - * In this case we are replacing the value, so we don't need to - * do more than swap the objects. + * In this case we are replacing the value, so we don't need to do + * more than swap the objects. */ varPtr->value.objPtr = newValuePtr; - Tcl_IncrRefCount(newValuePtr); /* var is another ref */ + Tcl_IncrRefCount(newValuePtr); /* var is another ref */ if (oldValuePtr != NULL) { - TclDecrRefCount(oldValuePtr); /* discard old value */ + TclDecrRefCount(oldValuePtr); /* discard old value */ } } TclSetVarScalar(varPtr); @@ -1682,7 +1684,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { goto cleanup; } @@ -1691,7 +1693,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) /* * Return the variable's value unless the variable was changed in some * gross way by a trace (e.g. it was unset and then recreated as an - * array). + * array). */ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) { @@ -1702,15 +1704,15 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) * A trace changed the value in some gross way. Return an empty string * object. */ - + resultPtr = iPtr->emptyObjPtr; /* - * If the variable doesn't exist anymore and no-one's using it, then - * free up the relevant structures and hash table entries. + * If the variable doesn't exist anymore and no-one's using it, then free + * up the relevant structures and hash table entries. */ - cleanup: + cleanup: if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } @@ -1723,15 +1725,15 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) * TclIncrVar2 -- * * Given a two-part variable name, which may refer either to a scalar - * variable or an element of an array, increment the Tcl object value - * of the variable by a specified amount. + * variable or an element of an array, increment the Tcl object value of + * the variable by a specified amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a + * variable. If the specified variable doesn't exist, or there is a * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in - * the interpreter's result. + * traces, then NULL is returned and a message will be left in the + * interpreter's result. * * Side effects: * The value of the given variable is incremented by the specified @@ -1745,19 +1747,19 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) Tcl_Obj * TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ - Tcl_Obj *part1Ptr; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ + Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ long incrAmount; /* Amount to be added to variable. */ - int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ + int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; char *part1, *part2; @@ -1781,16 +1783,15 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) * * TclPtrIncrVar -- * - * Given the pointers to a variable and possible containing array, - * increment the Tcl object value of the variable by a specified - * amount. + * Given the pointers to a variable and possible containing array, + * increment the Tcl object value of the variable by a specified amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a + * variable. If the specified variable doesn't exist, or there is a * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in - * the interpreter's result. + * traces, then NULL is returned and a message will be left in the + * interpreter's result. * * Side effects: * The value of the given variable is incremented by the specified @@ -1804,26 +1805,26 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) Tcl_Obj * TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ Var *varPtr; Var *arrayPtr; - CONST char *part1; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + CONST char *part1; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ CONST char *part2; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ CONST long incrAmount; /* Amount to be added to variable. */ - CONST int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ + CONST int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr; - int createdNewObj; /* Set 1 if var's value object is shared - * so we must increment a copy (i.e. copy - * on write). */ + int createdNewObj; /* Set 1 if var's value object is shared so we + * must increment a copy (i.e. copy on + * write). */ long i; varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); @@ -1835,10 +1836,10 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) } /* - * Increment the variable's value. If the object is unshared we can - * modify it directly, otherwise we must create a new copy to modify: - * this is "copy on write". Then free the variable's old string - * representation, if any, since it will no longer be valid. + * Increment the variable's value. If the object is unshared we can modify + * it directly, otherwise we must create a new copy to modify: this is + * "copy on write". Then free the variable's old string representation, if + * any, since it will no longer be valid. */ createdNewObj = 0; @@ -1857,6 +1858,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) /* * Not an integer or wide internal-rep... */ + Tcl_WideInt wide; if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { if (createdNewObj) { @@ -1875,7 +1877,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) /* * Store the variable's new value and run any write traces. */ - + return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, varValuePtr, flags); } @@ -1886,15 +1888,15 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) * TclIncrWideVar2 -- * * Given a two-part variable name, which may refer either to a scalar - * variable or an element of an array, increment the Tcl object value - * of the variable by a specified amount. + * variable or an element of an array, increment the Tcl object value of + * the variable by a specified amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a + * variable. If the specified variable doesn't exist, or there is a * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in - * the interpreter's result. + * traces, then NULL is returned and a message will be left in the + * interpreter's result. * * Side effects: * The value of the given variable is incremented by the specified @@ -1908,19 +1910,19 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) Tcl_Obj * TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ - Tcl_Obj *part1Ptr; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ + Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ Tcl_Obj *part2Ptr; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_WideInt incrAmount; /* Amount to be added to variable. */ - int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ + int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; char *part1, *part2; @@ -1944,16 +1946,15 @@ TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) * * TclPtrIncrWideVar -- * - * Given the pointers to a variable and possible containing array, - * increment the Tcl object value of the variable by a specified - * amount. + * Given the pointers to a variable and possible containing array, + * increment the Tcl object value of the variable by a specified amount. * * Results: * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a - * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in - * the interpreter's result. + * variable. If the specified variable doesn't exist, or there is a clash + * in array usage, or an error occurs while executing variable traces, + * then NULL is returned and a message will be left in the interpreter's + * result. * * Side effects: * The value of the given variable is incremented by the specified @@ -1967,27 +1968,27 @@ TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) Tcl_Obj * TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is - * to be found. */ + Tcl_Interp *interp; /* Command interpreter in which variable is to + * be found. */ Var *varPtr; Var *arrayPtr; - CONST char *part1; /* Points to an object holding the name of - * an array (if part2 is non-NULL) or the - * name of a variable. */ + CONST char *part1; /* Points to an object holding the name of an + * array (if part2 is non-NULL) or the name of + * a variable. */ CONST char *part2; /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ CONST Tcl_WideInt incrAmount; /* Amount to be added to variable. */ - CONST int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, - * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ + CONST int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr; - int createdNewObj; /* Set 1 if var's value object is shared - * so we must increment a copy (i.e. copy - * on write). */ + int createdNewObj; /* Set 1 if var's value object is shared so we + * must increment a copy (i.e. copy on + * write). */ Tcl_WideInt wide; varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); @@ -1999,10 +2000,10 @@ TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) } /* - * Increment the variable's value. If the object is unshared we can - * modify it directly, otherwise we must create a new copy to modify: - * this is "copy on write". Then free the variable's old string - * representation, if any, since it will no longer be valid. + * Increment the variable's value. If the object is unshared we can modify + * it directly, otherwise we must create a new copy to modify: this is + * "copy on write". Then free the variable's old string representation, if + * any, since it will no longer be valid. */ createdNewObj = 0; @@ -2020,9 +2021,10 @@ TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) /* * Not an integer or wide internal-rep... */ + if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { if (createdNewObj) { - Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ + TclDecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } @@ -2032,7 +2034,7 @@ TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) /* * Store the variable's new value and run any write traces. */ - + return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, varValuePtr, flags); } @@ -2045,25 +2047,25 @@ TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) * Delete a variable, so that it may not be accessed anymore. * * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR - * if the variable can't be unset. In the event of an error, - * if the TCL_LEAVE_ERR_MSG flag is set then an error message - * is left in the interp's result. + * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if + * the variable can't be unset. In the event of an error, if the + * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the + * interp's result. * * Side effects: - * If varName is defined as a local or global variable in interp, - * it is deleted. + * If varName is defined as a local or global variable in interp, it is + * deleted. * *---------------------------------------------------------------------- */ int Tcl_UnsetVar(interp, varName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ - CONST char *varName; /* Name of a variable in interp. May be - * either a scalar name or an array name - * or an element in an array. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ + CONST char *varName; /* Name of a variable in interp. May be either + * a scalar name or an array name or an + * element in an array. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or * TCL_LEAVE_ERR_MSG. */ @@ -2079,23 +2081,23 @@ Tcl_UnsetVar(interp, varName, flags) * Delete a variable, given a 2-part name. * * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR - * if the variable can't be unset. In the event of an error, - * if the TCL_LEAVE_ERR_MSG flag is set then an error message - * is left in the interp's result. + * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if + * the variable can't be unset. In the event of an error, if the + * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the + * interp's result. * * Side effects: - * If part1 and part2 indicate a local or global variable in interp, - * it is deleted. If part1 is an array name and part2 is NULL, then - * the whole array is deleted. + * If part1 and part2 indicate a local or global variable in interp, it + * is deleted. If part1 is an array name and part2 is NULL, then the + * whole array is deleted. * *---------------------------------------------------------------------- */ int Tcl_UnsetVar2(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of @@ -2112,7 +2114,6 @@ Tcl_UnsetVar2(interp, part1, part2, flags) return result; } - /* *---------------------------------------------------------------------- @@ -2122,23 +2123,23 @@ Tcl_UnsetVar2(interp, part1, part2, flags) * Delete a variable, given a 2-object name. * * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR - * if the variable can't be unset. In the event of an error, - * if the TCL_LEAVE_ERR_MSG flag is set then an error message - * is left in the interp's result. + * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if + * the variable can't be unset. In the event of an error, if the + * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the + * interp's result. * * Side effects: - * If part1ptr and part2Ptr indicate a local or global variable in interp, - * it is deleted. If part1Ptr is an array name and part2Ptr is NULL, then - * the whole array is deleted. + * If part1ptr and part2Ptr indicate a local or global variable in + * interp, it is deleted. If part1Ptr is an array name and part2Ptr is + * NULL, then the whole array is deleted. * *---------------------------------------------------------------------- */ int TclObjUnsetVar2(interp, part1Ptr, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ Tcl_Obj *part1Ptr; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of @@ -2160,7 +2161,7 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) if (varPtr == NULL) { return TCL_ERROR; } - + result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK); if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) { @@ -2168,16 +2169,15 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) } /* - * The code below is tricky, because of the possibility that - * a trace procedure might try to access a variable being - * deleted. To handle this situation gracefully, do things - * in three steps: - * 1. Copy the contents of the variable to a dummy variable - * structure, and mark the original Var structure as undefined. + * The code below is tricky, because of the possibility that a trace + * procedure might try to access a variable being deleted. To handle this + * situation gracefully, do things in three steps: + * 1. Copy the contents of the variable to a dummy variable structure, and + * mark the original Var structure as undefined. * 2. Invoke traces and clean up the variable, using the dummy copy. - * 3. If at the end of this the original variable is still - * undefined and has no outstanding references, then delete - * it (but it could have gotten recreated by a trace). + * 3. If at the end of this the original variable is still undefined and + * has no outstanding references, then delete * it (but it could have + * gotten recreated by a trace). */ dummyVar = *varPtr; @@ -2189,22 +2189,21 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) /* * Keep the variable alive until we're done with it. We used to - * increase/decrease the refCount for each operation, making it - * hard to find [Bug 735335] - caused by unsetting the variable - * whose value was the variable's name. + * increase/decrease the refCount for each operation, making it hard to + * find [Bug 735335] - caused by unsetting the variable whose value was + * the variable's name. */ - - varPtr->refCount++; + varPtr->refCount++; /* - * Call trace procedures for the variable being deleted. Then delete - * its traces. Be sure to abort any other traces for the variable - * that are still pending. Special tricks: + * Call trace procedures for the variable being deleted. Then delete its + * traces. Be sure to abort any other traces for the variable that are + * still pending. Special tricks: * 1. We need to increment varPtr's refCount around this: TclCallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. - * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to - * call unset traces even if other traces are pending. + * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call + * unset traces even if other traces are pending. */ if ((dummyVar.tracePtr != NULL) @@ -2219,7 +2218,7 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { + activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } @@ -2229,26 +2228,27 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) /* * If the variable is an array, delete all of its elements. This must be * done after calling the traces on the array, above (that's the way - * traces are defined). If it is a scalar, "discard" its object - * (decrement the ref count of its object, if any). + * traces are defined). If it is a scalar, "discard" its object (decrement + * the ref count of its object, if any). */ dummyVarPtr = &dummyVar; if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { /* - * Deleting the elements of the array may cause traces to be fired - * on those elements. Before deleting them, bump the reference count - * of the array, so that if those trace procs make a global or upvar - * link to the array, the array is not deleted when the call stack - * gets popped (we will delete the array ourselves later in this - * function). + * Deleting the elements of the array may cause traces to be fired on + * those elements. Before deleting them, bump the reference count of + * the array, so that if those trace procs make a global or upvar link + * to the array, the array is not deleted when the call stack gets + * popped (we will delete the array ourselves later in this function). * - * Bumping the count can lead to the odd situation that elements of the - * array are being deleted when the array still exists, but since the - * array is about to be removed anyway, that shouldn't really matter. + * Bumping the count can lead to the odd situation that elements of + * the array are being deleted when the array still exists, but since + * the array is about to be removed anyway, that shouldn't really + * matter. */ + DeleteArray(iPtr, part1, dummyVarPtr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); /* Decr ref count */ } @@ -2260,9 +2260,10 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) } /* - * If the variable was a namespace variable, decrement its reference count. + * If the variable was a namespace variable, decrement its reference + * count. */ - + if (TclIsVarNamespaceVar(varPtr)) { TclClearVarNamespaceVar(varPtr); varPtr->refCount--; @@ -2271,17 +2272,17 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) /* * It's an error to unset an undefined variable. */ - + if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, "unset", + TclVarErrMsg(interp, part1, part2, "unset", ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); } } #if ENABLE_NS_VARNAME_CACHING /* - * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType + * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType * keeping a reference. This removes some additional exteriorisations of * [Bug 736729], but may be a good thing independently of the bug. */ @@ -2291,7 +2292,7 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) part1Ptr->typePtr = NULL; } #endif - + /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of @@ -2337,17 +2338,19 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } else if (objc == 1) { /* - * Do nothing if no arguments supplied, so as to match - * command documentation. + * Do nothing if no arguments supplied, so as to match command + * documentation. */ + return TCL_OK; } /* - * Simple, restrictive argument parsing. The only options are -- - * and -nocomplain (which must come first and be given exactly to - * be an option). + * Simple, restrictive argument parsing. The only options are -- and + * -nocomplain (which must come first and be given exactly to be an + * option). */ + i = 1; name = TclGetString(objv[i]); if (name[0] == '-') { @@ -2378,8 +2381,8 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv) * * Tcl_AppendObjCmd -- * - * This object-based procedure is invoked to process the "append" - * Tcl command. See the user documentation for details on what it does. + * This object-based procedure is invoked to process the "append" Tcl + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. @@ -2403,7 +2406,7 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv) register Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler - * warning. */ + * warning. */ int i; if (objc < 2) { @@ -2423,16 +2426,16 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv) if (varPtr == NULL) { return TCL_ERROR; } - for (i = 2; i < objc; i++) { + for (i = 2; i < objc; i++) { /* - * Note that we do not need to increase the refCount of - * the Var pointers: should a trace delete the variable, - * the return value of TclPtrSetVar will be NULL, and we - * will not access the variable again. + * Note that we do not need to increase the refCount of the Var + * pointers: should a trace delete the variable, the return value + * of TclPtrSetVar will be NULL, and we will not access the + * variable again. */ - varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, - objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG)); + varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, + objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG)); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -2447,8 +2450,8 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv) * * Tcl_LappendObjCmd -- * - * This object-based procedure is invoked to process the "lappend" - * Tcl command. See the user documentation for details on what it does. + * This object-based procedure is invoked to process the "lappend" Tcl + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. @@ -2484,36 +2487,36 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) * The variable doesn't exist yet. Just create it with an empty * initial value. */ - + TclNewObj(varValuePtr); newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { - Tcl_DecrRefCount(varValuePtr); /* free unneeded object */ + TclDecrRefCount(varValuePtr); /* free unneeded object */ return TCL_ERROR; } } } else { /* - * We have arguments to append. We used to call Tcl_SetVar2 to - * append each argument one at a time to ensure that traces were run - * for each append step. We now append the arguments all at once - * because it's faster. Note that a read trace and a write trace for - * the variable will now each only be called once. Also, if the - * variable's old value is unshared we modify it directly, otherwise - * we create a new copy to modify: this is "copy on write". + * We have arguments to append. We used to call Tcl_SetVar2 to append + * each argument one at a time to ensure that traces were run for each + * append step. We now append the arguments all at once because it's + * faster. Note that a read trace and a write trace for the variable + * will now each only be called once. Also, if the variable's old + * value is unshared we modify it directly, otherwise we create a new + * copy to modify: this is "copy on write". */ createdNewObj = 0; createVar = 1; /* - * Use the TCL_TRACE_READS flag to ensure that if we have an - * array with no elements set yet, but with a read trace on it, - * we will create the variable and get read traces triggered. - * Note that you have to protect the variable pointers around - * the TclPtrGetVar call to insure that they remain valid - * even if the variable was undefined and unused. + * Use the TCL_TRACE_READS flag to ensure that if we have an array + * with no elements set yet, but with a read trace on it, we will + * create the variable and get read traces triggered. Note that you + * have to protect the variable pointers around the TclPtrGetVar call + * to insure that they remain valid even if the variable was undefined + * and unused. */ varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, @@ -2526,8 +2529,8 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) arrayPtr->refCount++; } part1 = TclGetString(objv[1]); - varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, - (TCL_TRACE_READS | TCL_LEAVE_ERR_MSG)); + varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, + (TCL_TRACE_READS | TCL_LEAVE_ERR_MSG)); varPtr->refCount--; if (arrayPtr != NULL) { arrayPtr->refCount--; @@ -2539,11 +2542,11 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ - + createVar = (TclIsVarUndefined(varPtr)); TclNewObj(varValuePtr); createdNewObj = 1; - } else if (Tcl_IsShared(varValuePtr)) { + } else if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } @@ -2555,22 +2558,22 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) } if (result != TCL_OK) { if (createdNewObj) { - Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */ + TclDecrRefCount(varValuePtr); /* free unneeded obj. */ } return result; } /* * Now store the list object back into the variable. If there is an - * error setting the new value, decrement its ref count if it - * was new and we didn't create the variable. + * error setting the new value, decrement its ref count if it was new + * and we didn't create the variable. */ - - newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, - varValuePtr, TCL_LEAVE_ERR_MSG); + + newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, + varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { if (createdNewObj && !createVar) { - Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */ + TclDecrRefCount(varValuePtr); /* free unneeded obj */ } return TCL_ERROR; } @@ -2617,7 +2620,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET, ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE, - ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; + ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; static CONST char *arrayOptions[] = { "anymore", "donesearch", "exists", "get", "names", "nextelement", "set", "size", "startsearch", "statistics", "unset", (char *) NULL @@ -2631,7 +2634,6 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) char *varName; int index, result; - if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?"); return TCL_ERROR; @@ -2645,15 +2647,15 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) /* * Locate the array variable */ - + varNamePtr = objv[2]; varName = TclGetString(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0, - /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); /* - * Special array trace used to keep the env array in sync for - * array names, array get, etc. + * Special array trace used to keep the env array in sync for array names, + * array get, etc. */ if (varPtr != NULL && varPtr->tracePtr != NULL @@ -2666,9 +2668,9 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } /* - * Verify that it is indeed an array variable. This test comes after - * the traces - the variable may actually become an array as an effect - * of said traces. + * Verify that it is indeed an array variable. This test comes after the + * traces - the variable may actually become an array as an effect of said + * traces. */ notArray = 0; @@ -2678,447 +2680,447 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } switch (index) { - case ARRAY_ANYMORE: { - ArraySearch *searchPtr; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); - return TCL_ERROR; - } - if (notArray) { - goto error; + case ARRAY_ANYMORE: { + ArraySearch *searchPtr; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); + return TCL_ERROR; + } + if (notArray) { + goto error; + } + searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + if (searchPtr == NULL) { + return TCL_ERROR; + } + while (1) { + Var *varPtr2; + + if (searchPtr->nextEntry != NULL) { + varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry); + if (!TclIsVarUndefined(varPtr2)) { + break; + } } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); - if (searchPtr == NULL) { - return TCL_ERROR; + searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search); + if (searchPtr->nextEntry == NULL) { + Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]); + return TCL_OK; } - while (1) { - Var *varPtr2; + } + Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]); + break; + } + case ARRAY_DONESEARCH: { + ArraySearch *searchPtr, *prevPtr; - if (searchPtr->nextEntry != NULL) { - varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry); - if (!TclIsVarUndefined(varPtr2)) { - break; - } - } - searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search); - if (searchPtr->nextEntry == NULL) { - Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]); - return TCL_OK; + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); + return TCL_ERROR; + } + if (notArray) { + goto error; + } + searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + if (searchPtr == NULL) { + return TCL_ERROR; + } + if (varPtr->searchPtr == searchPtr) { + varPtr->searchPtr = searchPtr->nextPtr; + } else { + for (prevPtr=varPtr->searchPtr ;; prevPtr=prevPtr->nextPtr) { + if (prevPtr->nextPtr == searchPtr) { + prevPtr->nextPtr = searchPtr->nextPtr; + break; } } - Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]); - break; } - case ARRAY_DONESEARCH: { - ArraySearch *searchPtr, *prevPtr; + ckfree((char *) searchPtr); + break; + } + case ARRAY_NEXTELEMENT: { + ArraySearch *searchPtr; + Tcl_HashEntry *hPtr; - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); - return TCL_ERROR; + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); + return TCL_ERROR; + } + if (notArray) { + goto error; + } + searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + if (searchPtr == NULL) { + return TCL_ERROR; + } + while (1) { + Var *varPtr2; + + hPtr = searchPtr->nextEntry; + if (hPtr == NULL) { + hPtr = Tcl_NextHashEntry(&searchPtr->search); + if (hPtr == NULL) { + return TCL_OK; + } + } else { + searchPtr->nextEntry = NULL; } - if (notArray) { - goto error; + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (!TclIsVarUndefined(varPtr2)) { + break; } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); - if (searchPtr == NULL) { - return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1)); + break; + } + case ARRAY_STARTSEARCH: { + ArraySearch *searchPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); + return TCL_ERROR; + } + if (notArray) { + goto error; + } + searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch)); + if (varPtr->searchPtr == NULL) { + searchPtr->id = 1; + Tcl_AppendResult(interp, "s-1-", varName, NULL); + } else { + char string[TCL_INTEGER_SPACE]; + + searchPtr->id = varPtr->searchPtr->id + 1; + TclFormatInt(string, searchPtr->id); + Tcl_AppendResult(interp, "s-", string, "-", varName, NULL); + } + searchPtr->varPtr = varPtr; + searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr, + &searchPtr->search); + searchPtr->nextPtr = varPtr->searchPtr; + varPtr->searchPtr = searchPtr; + break; + } + + case ARRAY_EXISTS: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]); + break; + case ARRAY_GET: { + Tcl_HashSearch search; + Var *varPtr2; + char *pattern = NULL; + char *name; + Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr; + int i, count; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); + return TCL_ERROR; + } + if (notArray) { + return TCL_OK; + } + if (objc == 4) { + pattern = TclGetString(objv[3]); + } + + /* + * Store the array names in a new object. + */ + + TclNewObj(nameLstPtr); + Tcl_IncrRefCount(nameLstPtr); + if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { + hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); + if (hPtr == NULL) { + goto searchDone; } - if (varPtr->searchPtr == searchPtr) { - varPtr->searchPtr = searchPtr->nextPtr; - } else { - for (prevPtr = varPtr->searchPtr; ; - prevPtr = prevPtr->nextPtr) { - if (prevPtr->nextPtr == searchPtr) { - prevPtr->nextPtr = searchPtr->nextPtr; - break; - } - } + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + goto searchDone; } - ckfree((char *) searchPtr); - break; - } - case ARRAY_EXISTS: { - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); - return TCL_ERROR; + result = Tcl_ListObjAppendElement(interp, nameLstPtr, + Tcl_NewStringObj(pattern, -1)); + if (result != TCL_OK) { + TclDecrRefCount(nameLstPtr); + return result; } - Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]); - break; + goto searchDone; } - case ARRAY_GET: { - Tcl_HashSearch search; - Var *varPtr2; - char *pattern = NULL; - char *name; - Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr; - int i, count; - - if ((objc != 3) && (objc != 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); - return TCL_ERROR; + for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); + hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + continue; } - if (notArray) { - return TCL_OK; + name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + if ((objc == 4) && !Tcl_StringMatch(name, pattern)) { + continue; /* element name doesn't match pattern */ } - if (objc == 4) { - pattern = TclGetString(objv[3]); + + namePtr = Tcl_NewStringObj(name, -1); + result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr); + if (result != TCL_OK) { + TclDecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(nameLstPtr); + return result; } + } - /* - * Store the array names in a new object. - */ + searchDone: + /* + * Make sure the Var structure of the array is not removed by a trace + * while we're working. + */ - TclNewObj(nameLstPtr); - Tcl_IncrRefCount(nameLstPtr); - if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - if (hPtr == NULL) { - goto searchDone; - } - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (TclIsVarUndefined(varPtr2)) { - goto searchDone; - } - result = Tcl_ListObjAppendElement(interp, nameLstPtr, - Tcl_NewStringObj(pattern, -1)); - if (result != TCL_OK) { - Tcl_DecrRefCount(nameLstPtr); - return result; - } - goto searchDone; - } - for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (TclIsVarUndefined(varPtr2)) { - continue; - } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); - if ((objc == 4) && !Tcl_StringMatch(name, pattern)) { - continue; /* element name doesn't match pattern */ - } - - namePtr = Tcl_NewStringObj(name, -1); - result = Tcl_ListObjAppendElement(interp, nameLstPtr, - namePtr); - if (result != TCL_OK) { - Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ - Tcl_DecrRefCount(nameLstPtr); - return result; - } - } -searchDone: + varPtr->refCount++; - /* - * Make sure the Var structure of the array is not removed by - * a trace while we're working. - */ + /* + * Get the array values corresponding to each element name + */ - varPtr->refCount++; + TclNewObj(tmpResPtr); + result = Tcl_ListObjGetElements(interp, nameLstPtr, + &count, &namePtrPtr); + if (result != TCL_OK) { + goto errorInArrayGet; + } - /* - * Get the array values corresponding to each element name - */ + for (i=0 ; i<count ; i++) { + namePtr = *namePtrPtr++; + valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr, + TCL_LEAVE_ERR_MSG); + if (valuePtr == NULL) { + /* + * Some trace played a trick on us; we need to diagnose to + * adapt our behaviour: was the array element unset, or did + * the modification modify the complete array? + */ - TclNewObj(tmpResPtr); - result = Tcl_ListObjGetElements(interp, nameLstPtr, - &count, &namePtrPtr); - if (result != TCL_OK) { - goto errorInArrayGet; - } - - for (i = 0; i < count; i++) { - namePtr = *namePtrPtr++; - valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr, - TCL_LEAVE_ERR_MSG); - if (valuePtr == NULL) { + if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { /* - * Some trace played a trick on us; we need to diagnose to - * adapt our behaviour: was the array element unset, or did - * the modification modify the complete array? + * The array itself looks OK, the variable was undefined: + * forget it. */ - if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { - /* - * The array itself looks OK, the variable was - * undefined: forget it. - */ - - continue; - } else { - result = TCL_ERROR; - goto errorInArrayGet; - } - } - result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr); - if (result != TCL_OK) { + continue; + } else { + result = TCL_ERROR; goto errorInArrayGet; } } - varPtr->refCount--; - Tcl_SetObjResult(interp, tmpResPtr); - TclDecrRefCount(nameLstPtr); - break; + result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr); + if (result != TCL_OK) { + goto errorInArrayGet; + } + } + varPtr->refCount--; + Tcl_SetObjResult(interp, tmpResPtr); + TclDecrRefCount(nameLstPtr); + break; - errorInArrayGet: - varPtr->refCount--; - Tcl_DecrRefCount(nameLstPtr); - Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */ - return result; + errorInArrayGet: + varPtr->refCount--; + TclDecrRefCount(nameLstPtr); + TclDecrRefCount(tmpResPtr); /* free unneeded temp result */ + return result; + } + case ARRAY_NAMES: { + Tcl_HashSearch search; + Var *varPtr2; + char *pattern = NULL; + char *name; + Tcl_Obj *namePtr, *resultPtr; + int mode, matched = 0; + static CONST char *options[] = { + "-exact", "-glob", "-regexp", (char *) NULL + }; + enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP }; + + mode = OPT_GLOB; + + if ((objc < 3) || (objc > 5)) { + Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?"); + return TCL_ERROR; } - case ARRAY_NAMES: { - Tcl_HashSearch search; - Var *varPtr2; - char *pattern = NULL; - char *name; - Tcl_Obj *namePtr, *resultPtr; - int mode, matched = 0; - static CONST char *options[] = { - "-exact", "-glob", "-regexp", (char *) NULL - }; - enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP }; - - mode = OPT_GLOB; - - if ((objc < 3) || (objc > 5)) { - Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?"); + if (notArray) { + return TCL_OK; + } + if (objc == 4) { + pattern = TclGetString(objv[3]); + } else if (objc == 5) { + pattern = TclGetString(objv[4]); + if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0, + &mode) != TCL_OK) { return TCL_ERROR; } - if (notArray) { - return TCL_OK; - } - if (objc == 4) { - pattern = TclGetString(objv[3]); - } else if (objc == 5) { - pattern = TclGetString(objv[4]); - if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", - 0, &mode) != TCL_OK) { - return TCL_ERROR; - } - } - TclNewObj(resultPtr); - if ((((enum options) mode) == OPT_GLOB) && (pattern != NULL) - && TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - if ((hPtr != NULL) - && !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr)) - && (result = Tcl_ListObjAppendElement(interp, - resultPtr, Tcl_NewStringObj(pattern, -1))) != TCL_OK) { - Tcl_DecrRefCount(resultPtr); - return result; - } - Tcl_SetObjResult(interp, resultPtr); - return TCL_OK; - } - for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (TclIsVarUndefined(varPtr2)) { - continue; - } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); - if (objc > 3) { - switch ((enum options) mode) { - case OPT_EXACT: - matched = (strcmp(name, pattern) == 0); - break; - case OPT_GLOB: - matched = Tcl_StringMatch(name, pattern); - break; - case OPT_REGEXP: - matched = Tcl_RegExpMatch(interp, name, - pattern); - if (matched < 0) { - Tcl_DecrRefCount(resultPtr); - return TCL_ERROR; - } - break; - } - if (matched == 0) { - continue; - } - } - - namePtr = Tcl_NewStringObj(name, -1); - result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); + } + TclNewObj(resultPtr); + if (((enum options) mode)==OPT_GLOB && pattern!=NULL && + TclMatchIsTrivial(pattern)) { + hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); + if ((hPtr != NULL) && + !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))) { + result = Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewStringObj(pattern, -1)); if (result != TCL_OK) { - Tcl_DecrRefCount(resultPtr); - Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(resultPtr); return result; } } Tcl_SetObjResult(interp, resultPtr); - break; + return TCL_OK; } - case ARRAY_NEXTELEMENT: { - ArraySearch *searchPtr; - Tcl_HashEntry *hPtr; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); - return TCL_ERROR; - } - if (notArray) { - goto error; + for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); + hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + continue; } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); - if (searchPtr == NULL) { - return TCL_ERROR; - } - while (1) { - Var *varPtr2; - - hPtr = searchPtr->nextEntry; - if (hPtr == NULL) { - hPtr = Tcl_NextHashEntry(&searchPtr->search); - if (hPtr == NULL) { - return TCL_OK; + name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + if (objc > 3) { + switch ((enum options) mode) { + case OPT_EXACT: + matched = (strcmp(name, pattern) == 0); + break; + case OPT_GLOB: + matched = Tcl_StringMatch(name, pattern); + break; + case OPT_REGEXP: + matched = Tcl_RegExpMatch(interp, name, pattern); + if (matched < 0) { + TclDecrRefCount(resultPtr); + return TCL_ERROR; } - } else { - searchPtr->nextEntry = NULL; - } - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (!TclIsVarUndefined(varPtr2)) { break; } + if (matched == 0) { + continue; + } } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1)); - break; - } - case ARRAY_SET: { - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName list"); - return TCL_ERROR; + + namePtr = Tcl_NewStringObj(name, -1); + result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); + if (result != TCL_OK) { + TclDecrRefCount(resultPtr); + TclDecrRefCount(namePtr); /* free unneeded name obj */ + return result; } - return TclArraySet(interp, objv[2], objv[3]); } - case ARRAY_SIZE: { - Tcl_HashSearch search; - Var *varPtr2; - int size; + Tcl_SetObjResult(interp, resultPtr); + break; + } + case ARRAY_SET: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName list"); + return TCL_ERROR; + } + return TclArraySet(interp, objv[2], objv[3]); + case ARRAY_UNSET: { + Tcl_HashSearch search; + Var *varPtr2; + char *pattern = NULL; + char *name; + + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); + return TCL_ERROR; + } + if (notArray) { + return TCL_OK; + } + if (objc == 3) { + /* + * When no pattern is given, just unset the whole array. + */ - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); + if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0) != TCL_OK) { return TCL_ERROR; } - size = 0; - if (!notArray) { - for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, - &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (TclIsVarUndefined(varPtr2)) { - continue; - } - size++; + } else { + pattern = TclGetString(objv[3]); + if (TclMatchIsTrivial(pattern)) { + hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); + if (hPtr != NULL && + !TclIsVarUndefined((Var *)Tcl_GetHashValue(hPtr))){ + return TclObjUnsetVar2(interp, varNamePtr, pattern, 0); + } + return TCL_OK; + } + for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); + hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + continue; + } + name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + if (Tcl_StringMatch(name, pattern) && + TclObjUnsetVar2(interp, varNamePtr, name, + 0) != TCL_OK) { + return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); - break; } - case ARRAY_STARTSEARCH: { - ArraySearch *searchPtr; + break; + } - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); - return TCL_ERROR; - } - if (notArray) { - goto error; - } - searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch)); - if (varPtr->searchPtr == NULL) { - searchPtr->id = 1; - Tcl_AppendResult(interp, "s-1-", varName, NULL); - } else { - char string[TCL_INTEGER_SPACE]; + case ARRAY_SIZE: { + Tcl_HashSearch search; + Var *varPtr2; + int size; - searchPtr->id = varPtr->searchPtr->id + 1; - TclFormatInt(string, searchPtr->id); - Tcl_AppendResult(interp, "s-", string, "-", varName, NULL); - } - searchPtr->varPtr = varPtr; - searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr, - &searchPtr->search); - searchPtr->nextPtr = varPtr->searchPtr; - varPtr->searchPtr = searchPtr; - break; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); + return TCL_ERROR; } + size = 0; - case ARRAY_STATISTICS: { - CONST char *stats; - - if (notArray) { - goto error; - } + /* + * Must iterate in order to get chance to check for present but + * "undefined" entries. + */ - stats = Tcl_HashStats(varPtr->value.tablePtr); - if (stats != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); - ckfree((void *)stats); - } else { - Tcl_SetResult(interp, "error reading array statistics", - TCL_STATIC); - return TCL_ERROR; - } - break; - } - - case ARRAY_UNSET: { - Tcl_HashSearch search; - Var *varPtr2; - char *pattern = NULL; - char *name; - - if ((objc != 3) && (objc != 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); - return TCL_ERROR; - } - if (notArray) { - return TCL_OK; - } - if (objc == 3) { - /* - * When no pattern is given, just unset the whole array - */ - if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0) - != TCL_OK) { - return TCL_ERROR; - } - } else { - pattern = TclGetString(objv[3]); - if (TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - result = TCL_OK; - (hPtr != NULL) - && !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr)) - && (result - = TclObjUnsetVar2(interp, varNamePtr, pattern, 0)); - return result; - } - for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, - &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); - if (TclIsVarUndefined(varPtr2)) { - continue; - } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); - if (Tcl_StringMatch(name, pattern) && - (TclObjUnsetVar2(interp, varNamePtr, name, 0) - != TCL_OK)) { - return TCL_ERROR; - } + if (!notArray) { + for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); + hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + continue; } + size++; } - break; } + Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); + break; + } + + case ARRAY_STATISTICS: { + CONST char *stats; + + if (notArray) { + goto error; + } + + stats = Tcl_HashStats(varPtr->value.tablePtr); + if (stats != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); + ckfree((void *)stats); + } else { + Tcl_SetResult(interp, "error reading array statistics",TCL_STATIC); + return TCL_ERROR; + } + break; + } } return TCL_OK; - error: + error: Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL); return TCL_ERROR; } @@ -3128,9 +3130,9 @@ searchDone: * * TclArraySet -- * - * Set the elements of an array. If there are no elements to - * set, create an empty array. This routine is used by the - * Tcl_ArrayObjCmd and by the TclSetupEnv routine. + * Set the elements of an array. If there are no elements to set, create + * an empty array. This routine is used by the Tcl_ArrayObjCmd and by + * the TclSetupEnv routine. * * Results: * A standard Tcl result object. @@ -3145,14 +3147,14 @@ int TclArraySet(interp, arrayNameObj, arrayElemObj) Tcl_Interp *interp; /* Current interpreter. */ Tcl_Obj *arrayNameObj; /* The array name. */ - Tcl_Obj *arrayElemObj; /* The array elements list or dict. If - * this is NULL, create an empty array. */ + Tcl_Obj *arrayElemObj; /* The array elements list or dict. If this + * is NULL, create an empty array. */ { Var *varPtr, *arrayPtr; Tcl_Obj **elemPtrs; int result, elemLen, i, nameLen; char *varName, *p; - + varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen); p = varName + nameLen - 1; if (*p == ')') { @@ -3189,27 +3191,28 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) } if (done == 0) { /* - * Empty, so we'll just force the array to be properly - * existing instead. + * Empty, so we'll just force the array to be properly existing + * instead. */ + goto ensureArray; } /* - * Don't need to look at result of Tcl_DictObjFirst as we've - * just successfully used a dictionary operation on the same - * object. + * Don't need to look at result of Tcl_DictObjFirst as we've just + * successfully used a dictionary operation on the same object. */ for (Tcl_DictObjFirst(interp, arrayElemObj, &search, &keyPtr, &valuePtr, &done) ; !done ; Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) { /* - * At this point, it would be nice if the key was directly - * usable by the array. This isn't the case though. + * At this point, it would be nice if the key was directly usable + * by the array. This isn't the case though. */ + char *part2 = TclGetString(keyPtr); - Var *elemVarPtr = TclLookupArrayElement(interp, varName, + Var *elemVarPtr = TclLookupArrayElement(interp, varName, part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr); if ((elemVarPtr == NULL) || @@ -3241,14 +3244,14 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) } /* - * We needn't worry about traces invalidating arrayPtr: should - * that be the case, TclPtrSetVar will return NULL so that we - * break out of the loop and return an error. + * We needn't worry about traces invalidating arrayPtr: should that be + * the case, TclPtrSetVar will return NULL so that we break out of the + * loop and return an error. */ for (i = 0; i < elemLen; i += 2) { char *part2 = TclGetString(elemPtrs[i]); - Var *elemVarPtr = TclLookupArrayElement(interp, varName, + Var *elemVarPtr = TclLookupArrayElement(interp, varName, part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr); if ((elemVarPtr == NULL) || (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2, @@ -3261,17 +3264,17 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) } /* - * The list is empty make sure we have an array, or create - * one if necessary. + * The list is empty make sure we have an array, or create one if + * necessary. */ - ensureArray: + ensureArray: if (varPtr != NULL) { if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) { /* * Already an array, done. */ - + return TCL_OK; } if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) { @@ -3279,8 +3282,7 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) * Either an array element, or a scalar: lose! */ - TclVarErrMsg(interp, varName, (char *)NULL, "array set", - needArray); + TclVarErrMsg(interp, varName, (char*)NULL, "array set", needArray); return TCL_ERROR; } } @@ -3301,8 +3303,8 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) * commands. * * Results: - * A standard Tcl completion code. If an error occurs then an - * error message is left in iPtr->result. + * A standard Tcl completion code. If an error occurs then an error + * message is left in iPtr->result. * * Side effects: * The variable given by myName is linked to the variable in framePtr @@ -3313,9 +3315,10 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) */ static int -ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, index) - Tcl_Interp *interp; /* Interpreter containing variables. Used - * for error messages, too. */ +ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, + myFlags, index) + Tcl_Interp *interp; /* Interpreter containing variables. Used for + * error messages, too. */ CallFrame *framePtr; /* Call frame containing "other" variable. * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr; @@ -3326,8 +3329,8 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, * otherP1/otherP2. Must be a scalar. */ int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ - int index; /* If the variable to be linked is an indexed - * scalar, this is its index. Otherwise, -1. */ + int index; /* If the variable to be linked is an indexed + * scalar, this is its index. Otherwise, -1 */ { Interp *iPtr = (Interp *) interp; Var *otherPtr, *varPtr, *arrayPtr; @@ -3336,9 +3339,9 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, CONST char *p; /* - * Find "other" in "framePtr". If not looking up other in just the - * current namespace, temporarily replace the current var frame - * pointer in the interpreter in order to use TclObjLookupVar. + * Find "other" in "framePtr". If not looking up other in just the current + * namespace, temporarily replace the current var frame pointer in the + * interpreter in order to use TclObjLookupVar. */ varFramePtr = iPtr->varFramePtr; @@ -3347,7 +3350,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, } otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2, (otherFlags | TCL_LEAVE_ERR_MSG), "access", - /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); + /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = varFramePtr; } @@ -3362,13 +3365,13 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, varPtr = &(varFramePtr->compiledLocals[index]); } else { /* - * Check that we are not trying to create a namespace var linked to - * a local variable in a procedure. If we allowed this, the local - * variable in the shorter-lived procedure frame could go away - * leaving the namespace var's reference invalid. + * Check that we are not trying to create a namespace var linked to a + * local variable in a procedure. If we allowed this, the local + * variable in the shorter-lived procedure frame could go away leaving + * the namespace var's reference invalid. */ - - if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) + + if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) @@ -3378,41 +3381,40 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, "refers to procedure variable", (char *) NULL); return TCL_ERROR; } - + /* - * Do not permit the new variable to look like an array reference, - * as it will not be reachable in that case [Bug 600812, TIP 184]. - * The "definition" of what "looks like an array reference" is - * consistent (and must remain consistent) with the code in - * TclObjLookupVar(). + * Do not permit the new variable to look like an array reference, as + * it will not be reachable in that case [Bug 600812, TIP 184]. The + * "definition" of what "looks like an array reference" is consistent + * (and must remain consistent) with the code in TclObjLookupVar(). */ p = strstr(myName, "("); if (p != NULL) { p += strlen(p)-1; if (*p == ')') { - /* + /* * myName looks like an array reference. */ - + Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", - myName, "\": upvar won't create a scalar variable that ", - "looks like an array element", (char *) NULL); + myName, "\": upvar won't create a scalar variable ", + "that looks like an array element", (char *) NULL); return TCL_ERROR; } } /* * Lookup and eventually create the new variable. Set the flag bit - * LOOKUP_FOR_UPVAR to indicate the special resolution rules for - * upvar purposes: + * LOOKUP_FOR_UPVAR to indicate the special resolution rules for upvar + * purposes: * - Bug #696893 - variable is either proc-local or in the current - * namespace; never follow the second (global) resolution path + * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers */ - - varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), - /* create */ 1, &errMsg, &index); + + varPtr = TclLookupSimpleVar(interp, myName, (myFlags|LOOKUP_FOR_UPVAR), + /* create */ 1, &errMsg, &index); if (varPtr == NULL) { TclVarErrMsg(interp, myName, NULL, "create", errMsg); return TCL_ERROR; @@ -3421,20 +3423,20 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, if (varPtr == otherPtr) { Tcl_SetResult((Tcl_Interp *) iPtr, - "can't upvar from variable to itself", TCL_STATIC); + "can't upvar from variable to itself", TCL_STATIC); return TCL_ERROR; } if (varPtr->tracePtr != NULL) { Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, - "\" has traces: can't use for upvar", (char *) NULL); + "\" has traces: can't use for upvar", (char *) NULL); return TCL_ERROR; } else if (!TclIsVarUndefined(varPtr)) { /* * The variable already existed. Make sure this variable "varPtr" - * isn't the same as "otherPtr" (avoid circular links). Also, if - * it's not an upvar then it's an error. If it is an upvar, then - * just disconnect it from the thing it currently refers to. + * isn't the same as "otherPtr" (avoid circular links). Also, if it's + * not an upvar then it's an error. If it is an upvar, then just + * disconnect it from the thing it currently refers to. */ if (TclIsVarLink(varPtr)) { @@ -3464,31 +3466,30 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, * * Tcl_UpVar -- * - * This procedure links one variable to another, just like - * the "upvar" command. + * This procedure links one variable to another, just like the "upvar" + * command. * * Results: - * A standard Tcl completion code. If an error occurs then - * an error message is left in the interp's result. + * A standard Tcl completion code. If an error occurs then an error + * message is left in the interp's result. * * Side effects: * The variable in frameName whose name is given by varName becomes - * accessible under the name localName, so that references to - * localName are redirected to the other variable like a symbolic - * link. + * accessible under the name localName, so that references to localName + * are redirected to the other variable like a symbolic link. * *---------------------------------------------------------------------- */ int Tcl_UpVar(interp, frameName, varName, localName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is - * to be looked up. */ + Tcl_Interp *interp; /* Command interpreter in which varName is to + * be looked up. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ CONST char *varName; /* Name of a variable in interp to link to. - * May be either a scalar name or an - * element in an array. */ + * May be either a scalar name or an element + * in an array. */ CONST char *localName; /* Name of link variable. */ int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ @@ -3501,31 +3502,30 @@ Tcl_UpVar(interp, frameName, varName, localName, flags) * * Tcl_UpVar2 -- * - * This procedure links one variable to another, just like - * the "upvar" command. + * This procedure links one variable to another, just like the "upvar" + * command. * * Results: - * A standard Tcl completion code. If an error occurs then - * an error message is left in the interp's result. + * A standard Tcl completion code. If an error occurs then an error + * message is left in the interp's result. * * Side effects: - * The variable in frameName whose name is given by part1 and - * part2 becomes accessible under the name localName, so that - * references to localName are redirected to the other variable - * like a symbolic link. + * The variable in frameName whose name is given by part1 and part2 + * becomes accessible under the name localName, so that references to + * localName are redirected to the other variable like a symbolic link. * *---------------------------------------------------------------------- */ int Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) - Tcl_Interp *interp; /* Interpreter containing variables. Used - * for error messages too. */ + Tcl_Interp *interp; /* Interpreter containing variables. Used for + * error messages too. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ CONST char *part1; - CONST char *part2; /* Two parts of source variable name to - * link to. */ + CONST char *part2; /* Two parts of source variable name to link + * to. */ CONST char *localName; /* Name of link variable. */ int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ @@ -3552,15 +3552,15 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) * * Tcl_GetVariableFullName -- * - * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this - * procedure appends to an object the namespace variable's full - * name, qualified by a sequence of parent namespace names. + * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this procedure + * appends to an object the namespace variable's full name, qualified by + * a sequence of parent namespace names. * * Results: - * None. + * None. * * Side effects: - * The variable's fully-qualified name is appended to the string + * The variable's fully-qualified name is appended to the string * representation of objPtr. * *---------------------------------------------------------------------- @@ -3568,7 +3568,7 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) void Tcl_GetVariableFullName(interp, variable, objPtr) - Tcl_Interp *interp; /* Interpreter containing the variable. */ + Tcl_Interp *interp; /* Interpreter containing the variable. */ Tcl_Var variable; /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr; /* Points to the object onto which the @@ -3579,8 +3579,8 @@ Tcl_GetVariableFullName(interp, variable, objPtr) char *name; /* - * Add the full name of the containing namespace (if any), followed by - * the "::" separator, then the variable name. + * Add the full name of the containing namespace (if any), followed by the + * "::" separator, then the variable name. */ if (varPtr != NULL) { @@ -3639,7 +3639,7 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv) /* * If we are not executing inside a Tcl procedure, just return. */ - + if ((iPtr->varFramePtr == NULL) || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) { return TCL_OK; @@ -3650,32 +3650,32 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv) * Make a local variable linked to its counterpart in the global :: * namespace. */ - + objPtr = objv[i]; varName = TclGetString(objPtr); /* * The variable name might have a scope qualifier, but the name for - * the local "link" variable must be the simple name at the tail. + * the local "link" variable must be the simple name at the tail. */ for (tail = varName; *tail != '\0'; tail++) { /* empty body */ } - while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { - tail--; + while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { + tail--; } - if ((*tail == ':') && (tail > varName)) { - tail++; + if ((*tail == ':') && (tail > varName)) { + tail++; } /* * Link to the variable "varName" in the global :: namespace. */ - + result = ObjMakeUpvar(interp, (CallFrame *) NULL, objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY, - /*myName*/ tail, /*myFlags*/ 0, -1); + /*myName*/ tail, /*myFlags*/ 0, -1); if (result != TCL_OK) { return result; } @@ -3698,22 +3698,21 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv) * optional. * * If the variable does not exist, it is created and given the optional - * value. If it already exists, it is simply set to the optional - * value. Normally, "name" is an unqualified name, so it is created in - * the current namespace. If it includes namespace qualifiers, it can - * be created in another namespace. + * value. If it already exists, it is simply set to the optional value. + * Normally, "name" is an unqualified name, so it is created in the + * current namespace. If it includes namespace qualifiers, it can be + * created in another namespace. * - * If the variable command is executed inside a Tcl procedure, it - * creates a local variable linked to the newly-created namespace - * variable. + * If the variable command is executed inside a Tcl procedure, it creates + * a local variable linked to the newly-created namespace variable. * * Results: - * Returns TCL_OK if the variable is found or created. Returns - * TCL_ERROR if anything goes wrong. + * Returns TCL_OK if the variable is found or created. Returns TCL_ERROR + * if anything goes wrong. * * Side effects: - * If anything goes wrong, this procedure returns an error message - * as the result in the interpreter's result object. + * If anything goes wrong, this procedure returns an error message as the + * result in the interpreter's result object. * *---------------------------------------------------------------------- */ @@ -3739,31 +3738,32 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) for (i = 1; i < objc; i = i+2) { /* - * Look up each variable in the current namespace context, creating - * it if necessary. + * Look up each variable in the current namespace context, creating it + * if necessary. */ - + varNamePtr = objv[i]; varName = TclGetString(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, - (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define", - /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); - - if (arrayPtr != NULL) { - /* - * Variable cannot be an element in an array. If arrayPtr is - * non-null, it is, so throw up an error and return. - */ - TclVarErrMsg(interp, varName, NULL, "define", isArrayElement); - return TCL_ERROR; - } + (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define", + /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); + + if (arrayPtr != NULL) { + /* + * Variable cannot be an element in an array. If arrayPtr is + * non-null, it is, so throw up an error and return. + */ + + TclVarErrMsg(interp, varName, NULL, "define", isArrayElement); + return TCL_ERROR; + } if (varPtr == NULL) { return TCL_ERROR; } /* - * Mark the variable as a namespace variable and increment its + * Mark the variable as a namespace variable and increment its * reference count so that it will persist until its namespace is * destroyed or until the variable is unset. */ @@ -3775,10 +3775,9 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) /* * If a value was specified, set the variable to that value. - * Otherwise, if the variable is new, leave it undefined. - * (If the variable already exists and no value was specified, - * leave its value unchanged; just create the local link if - * we're in a Tcl procedure). + * Otherwise, if the variable is new, leave it undefined. (If the + * variable already exists and no value was specified, leave its value + * unchanged; just create the local link if we're in a Tcl procedure). */ if (i+1 < objc) { /* a value was specified */ @@ -3790,12 +3789,12 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) } /* - * If we are executing inside a Tcl procedure, create a local - * variable linked to the new namespace variable "varName". + * If we are executing inside a Tcl procedure, create a local variable + * linked to the new namespace variable "varName". */ if ((iPtr->varFramePtr != NULL) - && (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) { + && (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) { /* * varName might have a scope qualifier, but the name for the * local "link" variable must be the simple name at the tail. @@ -3804,22 +3803,22 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) * consecutive ":" characters). */ - for (tail = cp = varName; *cp != '\0'; ) { + for (tail=cp=varName ; *cp!='\0' ;) { if (*cp++ == ':') { while (*cp == ':') { tail = ++cp; } } } - + /* * Create a local link "tail" to the variable "varName" in the * current namespace. */ - + result = ObjMakeUpvar(interp, (CallFrame *) NULL, /*otherP1*/ varNamePtr, /*otherP2*/ NULL, - /*otherFlags*/ TCL_NAMESPACE_ONLY, + /*otherFlags*/ TCL_NAMESPACE_ONLY, /*myName*/ tail, /*myFlags*/ 0, -1); if (result != TCL_OK) { return result; @@ -3834,8 +3833,8 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) * * Tcl_UpvarObjCmd -- * - * This object-based procedure is invoked to process the "upvar" - * Tcl command. See the user documentation for details on what it does. + * This object-based procedure is invoked to process the "upvar" Tcl + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. @@ -3859,7 +3858,7 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv) int result; if (objc < 3) { - upvarSyntax: + upvarSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?"); return TCL_ERROR; @@ -3867,7 +3866,7 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv) /* * Find the call frame containing each of the "other variables" to be - * linked to. + * linked to. */ result = TclObjGetFrame(interp, objv[1], &framePtr); @@ -3881,12 +3880,12 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv) objv += result+1; /* - * Iterate over each (other variable, local variable) pair. - * Divide the other variable name into two parts, then call - * MakeUpvar to do all the work of linking it to the local variable. + * Iterate over each (other variable, local variable) pair. Divide the + * other variable name into two parts, then call MakeUpvar to do all the + * work of linking it to the local variable. */ - for ( ; objc > 0; objc -= 2, objv += 2) { + for (; objc>0 ; objc-=2, objv+=2) { localName = TclGetString(objv[1]); result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0], NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1); @@ -3902,15 +3901,15 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv) * * NewVar -- * - * Create a new heap-allocated variable that will eventually be - * entered into a hashtable. + * Create a new heap-allocated variable that will eventually be entered + * into a hashtable. * * Results: * The return value is a pointer to the new variable structure. It is * marked as a scalar variable (and not a link or array variable). Its * value initially is NULL. The variable is not part of any hash table - * yet. Since it will be in a hashtable and not in a call frame, its - * name field is set NULL. It is initially marked as undefined. + * yet. Since it will be in a hashtable and not in a call frame, its name + * field is set NULL. It is initially marked as undefined. * * Side effects: * Storage gets allocated. @@ -3940,18 +3939,17 @@ NewVar() * * SetArraySearchObj -- * - * This function converts the given tcl object into one that - * has the "array search" internal type. + * This function converts the given tcl object into one that has the + * "array search" internal type. * * Results: - * TCL_OK if the conversion succeeded, and TCL_ERROR if it failed - * (when an error message will be placed in the interpreter's - * result.) + * TCL_OK if the conversion succeeded, and TCL_ERROR if it failed (when + * an error message will be placed in the interpreter's result.) * * Side effects: - * Updates the internal type and representation of the object to - * make this an array-search object. See the tclArraySearchType - * declaration above for details of the internal representation. + * Updates the internal type and representation of the object to make + * this an array-search object. See the tclArraySearchType declaration + * above for details of the internal representation. * *---------------------------------------------------------------------- */ @@ -3975,28 +3973,33 @@ SetArraySearchObj(interp, objPtr) /* * Parse the id into the three parts separated by dashes. */ + if ((string[0] != 's') || (string[1] != '-')) { - syntax: - Tcl_AppendResult(interp, "illegal search identifier \"", string, - "\"", (char *) NULL); - return TCL_ERROR; + goto syntax; } id = strtoul(string+2, &end, 10); if ((end == (string+2)) || (*end != '-')) { goto syntax; } + /* - * Can't perform value check in this context, so place reference - * to place in string to use for the check in the object instead. + * Can't perform value check in this context, so place reference to place + * in string to use for the check in the object instead. */ + end++; offset = end - string; TclFreeIntRep(objPtr); objPtr->typePtr = &tclArraySearchType; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id); - objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL) + id); + objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL) + offset); return TCL_OK; + + syntax: + Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"", + (char *) NULL); + return TCL_ERROR; } /* @@ -4004,13 +4007,13 @@ SetArraySearchObj(interp, objPtr) * * ParseSearchId -- * - * This procedure translates from a tcl object to a pointer to an - * active array search (if there is one that matches the string). + * This procedure translates from a tcl object to a pointer to an active + * array search (if there is one that matches the string). * * Results: - * The return value is a pointer to the array search indicated - * by string, or NULL if there isn't one. If NULL is returned, - * the interp's result contains an error message. + * The return value is a pointer to the array search indicated by string, + * or NULL if there isn't one. If NULL is returned, the interp's result + * contains an error message. * * Side effects: * The tcl object might have its internal type and representation @@ -4038,21 +4041,26 @@ ParseSearchId(interp, varPtr, varName, handleObj) /* * Parse the id. */ + if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) { return NULL; } + /* * Cast is safe, since always came from an int in the first place. */ + id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) - - ((char*)NULL)); + ((char*)NULL)); string = TclGetString(handleObj); offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) - - ((char*)NULL)); + ((char*)NULL)); + /* - * This test cannot be placed inside the Tcl_Obj machinery, since - * it is dependent on the variable context. + * This test cannot be placed inside the Tcl_Obj machinery, since it is + * dependent on the variable context. */ + if (strcmp(string+offset, varName) != 0) { Tcl_AppendResult(interp, "search identifier \"", string, "\" isn't for variable \"", varName, "\"", (char *) NULL); @@ -4060,16 +4068,16 @@ ParseSearchId(interp, varPtr, varName, handleObj) } /* - * Search through the list of active searches on the interpreter - * to see if the desired one exists. + * Search through the list of active searches on the interpreter to see if + * the desired one exists. * - * Note that we cannot store the searchPtr directly in the Tcl_Obj - * as that would run into trouble when DeleteSearches() was called - * so we must scan this list every time. + * Note that we cannot store the searchPtr directly in the Tcl_Obj as that + * would run into trouble when DeleteSearches() was called so we must scan + * this list every time. */ for (searchPtr = varPtr->searchPtr; searchPtr != NULL; - searchPtr = searchPtr->nextPtr) { + searchPtr = searchPtr->nextPtr) { if (searchPtr->id == id) { return searchPtr; } @@ -4084,8 +4092,8 @@ ParseSearchId(interp, varPtr, varName, handleObj) * * DeleteSearches -- * - * This procedure is called to free up all of the searches - * associated with an array variable. + * This procedure is called to free up all of the searches associated + * with an array variable. * * Results: * None. @@ -4098,8 +4106,8 @@ ParseSearchId(interp, varPtr, varName, handleObj) static void DeleteSearches(arrayVarPtr) - register Var *arrayVarPtr; /* Variable whose searches are - * to be deleted. */ + register Var *arrayVarPtr; /* Variable whose searches are to be + * deleted. */ { ArraySearch *searchPtr; @@ -4115,18 +4123,17 @@ DeleteSearches(arrayVarPtr) * * TclDeleteVars -- * - * This procedure is called to recycle all the storage space - * associated with a table of variables. For this procedure - * to work correctly, it must not be possible for any of the - * variables in the table to be accessed from Tcl commands - * (e.g. from trace procedures). + * This procedure is called to recycle all the storage space associated + * with a table of variables. For this procedure to work correctly, it + * must not be possible for any of the variables in the table to be + * accessed from Tcl commands (e.g. from trace procedures). * * Results: * None. * * Side effects: - * Variables are deleted and trace procedures are invoked, if - * any are declared. + * Variables are deleted and trace procedures are invoked, if any are + * declared. * *---------------------------------------------------------------------- */ @@ -4166,11 +4173,11 @@ TclDeleteVars(iPtr, tablePtr) varPtr = (Var *) Tcl_GetHashValue(hPtr); /* - * For global/upvar variables referenced in procedures, decrement - * the reference count on the variable referred to, and free - * the referenced variable if it's no longer needed. Don't delete - * the hash entry for the other variable if it's in the same table - * as us: this will happen automatically later on. + * For global/upvar variables referenced in procedures, decrement the + * reference count on the variable referred to, and free the + * referenced variable if it's no longer needed. Don't delete the hash + * entry for the other variable if it's in the same table as us: this + * will happen automatically later on. */ if (TclIsVarLink(varPtr)) { @@ -4189,23 +4196,22 @@ TclDeleteVars(iPtr, tablePtr) } /* - * Invoke traces on the variable that is being deleted, then - * free up the variable's space (no need to free the hash - * entry here, unless we're dealing with a global variable: - * the hash entries will be deleted automatically when the - * whole table is deleted). Note that we give TclCallVarTraces - * the variable's fully-qualified name so that any called - * trace procedures can refer to these variables being + * Invoke traces on the variable that is being deleted, then free up + * the variable's space (no need to free the hash entry here, unless + * we're dealing with a global variable: the hash entries will be + * deleted automatically when the whole table is deleted). Note that + * we give TclCallVarTraces the variable's fully-qualified name so + * that any called trace procedures can refer to these variables being * deleted. */ if (varPtr->tracePtr != NULL) { TclNewObj(objPtr); - Tcl_IncrRefCount(objPtr); /* until done with traces */ + Tcl_IncrRefCount(objPtr); /* until done with traces */ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); TclCallVarTraces(iPtr, (Var *) NULL, varPtr, TclGetString(objPtr), NULL, flags, /* leaveErrMsg */ 0); - TclDecrRefCount(objPtr); /* free no longer needed obj */ + TclDecrRefCount(objPtr); /* free no longer needed obj */ while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; @@ -4213,16 +4219,15 @@ TclDeleteVars(iPtr, tablePtr) Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { + activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } } - + if (TclIsVarArray(varPtr)) { - DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr, - flags); + DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr, flags); varPtr->value.tablePtr = NULL; } if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) { @@ -4236,10 +4241,9 @@ TclDeleteVars(iPtr, tablePtr) TclSetVarScalar(varPtr); /* - * If the variable was a namespace variable, decrement its - * reference count. We are in the process of destroying its - * namespace so that namespace will no longer "refer" to the - * variable. + * If the variable was a namespace variable, decrement its reference + * count. We are in the process of destroying its namespace so that + * namespace will no longer "refer" to the variable. */ if (TclIsVarNamespaceVar(varPtr)) { @@ -4265,20 +4269,19 @@ TclDeleteVars(iPtr, tablePtr) * * TclDeleteCompiledLocalVars -- * - * This procedure is called to recycle storage space associated with - * the compiler-allocated array of local variables in a procedure call - * frame. This procedure resembles TclDeleteVars above except that each - * variable is stored in a call frame and not a hash table. For this - * procedure to work correctly, it must not be possible for any of the - * variable in the table to be accessed from Tcl commands (e.g. from - * trace procedures). + * This procedure is called to recycle storage space associated with the + * compiler-allocated array of local variables in a procedure call frame. + * This procedure resembles TclDeleteVars above except that each variable + * is stored in a call frame and not a hash table. For this procedure to + * work correctly, it must not be possible for any of the variable in the + * table to be accessed from Tcl commands (e.g. from trace procedures). * * Results: * None. * * Side effects: - * Variables are deleted and trace procedures are invoked, if - * any are declared. + * Variables are deleted and trace procedures are invoked, if any are + * declared. * *---------------------------------------------------------------------- */ @@ -4286,9 +4289,8 @@ TclDeleteVars(iPtr, tablePtr) void TclDeleteCompiledLocalVars(iPtr, framePtr) Interp *iPtr; /* Interpreter to which variables belong. */ - CallFrame *framePtr; /* Procedure call frame containing - * compiler-assigned local variables to - * delete. */ + CallFrame *framePtr; /* Procedure call frame containing compiler- + * assigned local variables to delete. */ { register Var *varPtr; int flags; /* Flags passed to trace procedures. */ @@ -4301,11 +4303,11 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) varPtr = framePtr->compiledLocals; for (i = 0; i < numLocals; i++) { /* - * For global/upvar variables referenced in procedures, decrement - * the reference count on the variable referred to, and free - * the referenced variable if it's no longer needed. Don't delete - * the hash entry for the other variable if it's in the same table - * as us: this will happen automatically later on. + * For global/upvar variables referenced in procedures, decrement the + * reference count on the variable referred to, and free the + * referenced variable if it's no longer needed. Don't delete the hash + * entry for the other variable if it's in the same table as us: this + * will happen automatically later on. */ if (TclIsVarLink(varPtr)) { @@ -4344,12 +4346,12 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) } } - /* + /* * Now if the variable is an array, delete its element hash table. - * Otherwise, if it's a scalar variable, decrement the ref count - * of its value. + * Otherwise, if it's a scalar variable, decrement the ref count of + * its value. */ - + if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) { DeleteArray(iPtr, varPtr->name, varPtr, flags); } @@ -4370,10 +4372,9 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) * * DeleteArray -- * - * This procedure is called to free up everything in an array - * variable. It's the caller's responsibility to make sure - * that the array is no longer accessible before this procedure - * is called. + * This procedure is called to free up everything in an array variable. + * It's the caller's responsibility to make sure that the array is no + * longer accessible before this procedure is called. * * Results: * None. @@ -4381,23 +4382,22 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) * Side effects: * All storage associated with varPtr's array elements is deleted * (including the array's hash table). Deletion trace procedures for - * array elements are invoked, then deleted. Any pending traces for - * array elements are also deleted. + * array elements are invoked, then deleted. Any pending traces for array + * elements are also deleted. * *---------------------------------------------------------------------- */ static void DeleteArray(iPtr, arrayName, varPtr, flags) - Interp *iPtr; /* Interpreter containing array. */ - CONST char *arrayName; /* Name of array (used for trace - * callbacks). */ - Var *varPtr; /* Pointer to variable structure. */ - int flags; /* Flags to pass to TclCallVarTraces: - * TCL_TRACE_UNSETS and sometimes - * TCL_INTERP_DESTROYED, - * TCL_NAMESPACE_ONLY, or - * TCL_GLOBAL_ONLY. */ + Interp *iPtr; /* Interpreter containing array. */ + CONST char *arrayName; /* Name of array (used for trace + * callbacks). */ + Var *varPtr; /* Pointer to variable structure. */ + int flags; /* Flags to pass to TclCallVarTraces: + * TCL_TRACE_UNSETS and sometimes + * TCL_INTERP_DESTROYED, TCL_NAMESPACE_ONLY, + * or TCL_GLOBAL_ONLY. */ { Tcl_HashSearch search; register Tcl_HashEntry *hPtr; @@ -4407,7 +4407,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags) DeleteSearches(varPtr); for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { elPtr = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { objPtr = elPtr->value.objPtr; @@ -4437,10 +4437,9 @@ DeleteArray(iPtr, arrayName, varPtr, flags) /* * Even though array elements are not supposed to be namespace - * variables, some combinations of [upvar] and [variable] may - * create such beasts - see [Bug 604239]. This is necessary to - * avoid leaking the corresponding Var struct, and is otherwise - * harmless. + * variables, some combinations of [upvar] and [variable] may create + * such beasts - see [Bug 604239]. This is necessary to avoid leaking + * the corresponding Var struct, and is otherwise harmless. */ if (TclIsVarNamespaceVar(elPtr)) { @@ -4460,30 +4459,29 @@ DeleteArray(iPtr, arrayName, varPtr, flags) * * TclCleanupVar -- * - * This procedure is called when it looks like it may be OK to free up - * a variable's storage. If the variable is in a hashtable, its Var + * This procedure is called when it looks like it may be OK to free up a + * variable's storage. If the variable is in a hashtable, its Var * structure and hash table entry will be freed along with those of its - * containing array, if any. This procedure is called, for example, - * when a trace on a variable deletes a variable. + * containing array, if any. This procedure is called, for example, when + * a trace on a variable deletes a variable. * * Results: * None. * * Side effects: * If the variable (or its containing array) really is dead and in a - * hashtable, then its Var structure, and possibly its hash table - * entry, is freed up. + * hashtable, then its Var structure, and possibly its hash table entry, + * is freed up. * *---------------------------------------------------------------------- */ void TclCleanupVar(varPtr, arrayPtr) - Var *varPtr; /* Pointer to variable that may be a - * candidate for being expunged. */ - Var *arrayPtr; /* Array that contains the variable, or - * NULL if this variable isn't an array - * element. */ + Var *varPtr; /* Pointer to variable that may be a candidate + * for being expunged. */ + Var *arrayPtr; /* Array that contains the variable, or NULL + * if this variable isn't an array element. */ { if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0) && (varPtr->tracePtr == NULL) @@ -4496,7 +4494,7 @@ TclCleanupVar(varPtr, arrayPtr) if (arrayPtr != NULL) { if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0) && (arrayPtr->tracePtr == NULL) - && (arrayPtr->flags & VAR_IN_HASHTABLE)) { + && (arrayPtr->flags & VAR_IN_HASHTABLE)) { if (arrayPtr->hPtr != NULL) { Tcl_DeleteHashEntry(arrayPtr->hPtr); } @@ -4509,34 +4507,34 @@ TclCleanupVar(varPtr, arrayPtr) * * TclVarErrMsg -- * - * Generate a reasonable error message describing why a variable - * operation failed. + * Generate a reasonable error message describing why a variable + * operation failed. * * Results: - * None. + * None. * * Side effects: - * The interp's result is set to hold a message identifying the - * variable given by part1 and part2 and describing why the - * variable operation failed. + * The interp's result is set to hold a message identifying the variable + * given by part1 and part2 and describing why the variable operation + * failed. * *---------------------------------------------------------------------- */ void TclVarErrMsg(interp, part1, part2, operation, reason) - Tcl_Interp *interp; /* Interpreter in which to record message. */ + Tcl_Interp *interp; /* Interpreter in which to record message. */ CONST char *part1; CONST char *part2; /* Variable's two-part name. */ - CONST char *operation; /* String describing operation that failed, - * e.g. "read", "set", or "unset". */ - CONST char *reason; /* String describing why operation failed. */ + CONST char *operation; /* String describing operation that failed, + * e.g. "read", "set", or "unset". */ + CONST char *reason; /* String describing why operation failed. */ { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't ", operation, " \"", part1, (char *) NULL); if (part2 != NULL) { - Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL); + Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL); } Tcl_AppendResult(interp, "\": ", reason, (char *) NULL); } @@ -4550,8 +4548,7 @@ TclVarErrMsg(interp, part1, part2, operation, reason) */ /* - * Panic functions that should never be called in normal - * operation. + * Panic functions that should never be called in normal operation. */ static void @@ -4572,7 +4569,7 @@ PanicOnSetVarName(interp, objPtr) return TCL_ERROR; } -/* +/* * localVarName - * * INTERNALREP DEFINITION: @@ -4589,21 +4586,20 @@ DupLocalVarName(srcPtr, dupPtr) } #if ENABLE_NS_VARNAME_CACHING -/* +/* * nsVarName - * * INTERNALREP DEFINITION: - * twoPtrValue.ptr1: pointer to the namespace containing the - * reference. - * twoPtrValue.ptr2: pointer to the corresponding Var + * twoPtrValue.ptr1: pointer to the namespace containing the reference. + * twoPtrValue.ptr2: pointer to the corresponding Var */ -static void +static void FreeNsVarName(objPtr) Tcl_Obj *objPtr; { register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2; - + varPtr->refCount--; if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) { TclCleanupVar(varPtr, NULL); @@ -4625,25 +4621,23 @@ DupNsVarName(srcPtr, dupPtr) } #endif -/* +/* * parsedVarName - * * INTERNALREP DEFINITION: - * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj - * (NULL if scalar) - * twoPtrValue.ptr2 = pointer to the element name string - * (owned by this Tcl_Obj), or NULL if - * it is a scalar variable + * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar) + * twoPtrValue.ptr2 = pointer to the element name string (owned by this + * Tcl_Obj), or NULL if it is a scalar variable */ -static void +static void FreeParsedVarName(objPtr) Tcl_Obj *objPtr; { - register Tcl_Obj *arrayPtr = - (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1; + register Tcl_Obj *arrayPtr = (Tcl_Obj *) + objPtr->internalRep.twoPtrValue.ptr1; register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2; - + if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); ckfree(elem); @@ -4655,8 +4649,8 @@ DupParsedVarName(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { - register Tcl_Obj *arrayPtr = - (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1; + register Tcl_Obj *arrayPtr = (Tcl_Obj *) + srcPtr->internalRep.twoPtrValue.ptr1; register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2; char *elemCopy; unsigned int elemLen; @@ -4686,11 +4680,12 @@ UpdateParsedVarName(objPtr) if (arrayPtr == NULL) { /* - * This is a parsed scalar name: what is it - * doing here? + * This is a parsed scalar name: what is it doing here? */ + Tcl_Panic("ERROR: scalar parsedVarName without a string rep.\n"); } + part1 = Tcl_GetStringFromObj(arrayPtr, &len1); len2 = strlen(part2); |