Attachment "tclVar.c.1.62.patch" to
ticket [585105ffff]
added by
jenglish
2002-07-30 08:48:09.
Index: tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.62
diff -c -r1.62 tclVar.c
*** tclVar.c 27 Jul 2002 01:44:24 -0000 1.62
--- tclVar.c 30 Jul 2002 01:46:56 -0000
***************
*** 15,21 ****
* 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.62 2002/07/27 01:44:24 msofer Exp $
*/
#include "tclInt.h"
--- 15,21 ----
* 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.60+1.62-1.61 2002/07/17 20:42:27 msofer Exp $
*/
#include "tclInt.h"
***************
*** 43,55 ****
*/
static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
! Var *varPtr, char *part1, CONST char *part2,
int flags, CONST int leaveErrMsg));
static void CleanupVar _ANSI_ARGS_((Var *varPtr,
Var *arrayPtr));
static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
static void DeleteArray _ANSI_ARGS_((Interp *iPtr,
! char *arrayName, Var *varPtr, int flags));
static void DisposeTraceResult _ANSI_ARGS_((int flags,
char *result));
static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp,
--- 43,55 ----
*/
static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
! Var *varPtr, CONST char *part1, CONST char *part2,
int flags, CONST int leaveErrMsg));
static void CleanupVar _ANSI_ARGS_((Var *varPtr,
Var *arrayPtr));
static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
static void DeleteArray _ANSI_ARGS_((Interp *iPtr,
! CONST char *arrayName, Var *varPtr, int flags));
static void DisposeTraceResult _ANSI_ARGS_((int flags,
char *result));
static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp,
***************
*** 182,188 ****
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
arrayPtrPtr)
Tcl_Interp *interp; /* Interpreter to use for lookup. */
! register 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. */
--- 182,188 ----
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
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. */
***************
*** 206,224 ****
Var *varPtr;
CONST char *elName; /* Name of array element or NULL; may be
* same as part2, or may be openParen+1. */
! char *openParen, *closeParen;
/* If this procedure parses a name into
! * array and index, these point to the
! * parens around the index. Otherwise they
! * are NULL. These are needed to restore
! * the parens after parsing the name. */
! register char *p;
CONST char *errMsg = NULL;
int index;
varPtr = NULL;
*arrayPtrPtr = NULL;
! openParen = closeParen = NULL;
/*
* Parse part1 into array name and index.
--- 206,226 ----
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. */
! register CONST char *p;
CONST char *errMsg = NULL;
int index;
+ #define VAR_NAME_BUF_SIZE 26
+ char buffer[VAR_NAME_BUF_SIZE];
+ char *newVarName = buffer;
varPtr = NULL;
*arrayPtrPtr = NULL;
! openParen = closeParen = -1;
/*
* Parse part1 into array name and index.
***************
*** 233,239 ****
elName = part2;
for (p = part1; *p ; p++) {
if (*p == '(') {
! openParen = p;
do {
p++;
} while (*p != '\0');
--- 235,241 ----
elName = part2;
for (p = part1; *p ; p++) {
if (*p == '(') {
! openParen = p - part1;
do {
p++;
} while (*p != '\0');
***************
*** 245,260 ****
}
return NULL;
}
! closeParen = p;
! *openParen = 0;
! *closeParen = 0;
! elName = openParen+1;
} else {
! openParen = NULL;
}
break;
}
}
varPtr = TclLookupSimpleVar(interp, part1, flags,
createPart1, &errMsg, &index);
--- 247,269 ----
}
return NULL;
}
! closeParen = p - part1;
} else {
! openParen = -1;
}
break;
}
}
+ if (openParen != -1) {
+ if (closeParen >= VAR_NAME_BUF_SIZE) {
+ newVarName = ckalloc((unsigned int) (closeParen+1));
+ }
+ memcpy(newVarName, part1, (unsigned int) closeParen);
+ newVarName[openParen] = '\0';
+ newVarName[closeParen] = '\0';
+ part1 = newVarName;
+ elName = newVarName + openParen + 1;
+ }
varPtr = TclLookupSimpleVar(interp, part1, flags,
createPart1, &errMsg, &index);
***************
*** 272,283 ****
msg, createPart1, createPart2, varPtr);
}
}
!
! if (openParen != NULL) {
! *openParen = '(';
! *closeParen = ')';
}
return varPtr;
}
/*
--- 281,293 ----
msg, createPart1, createPart2, varPtr);
}
}
! if (newVarName != buffer) {
! ckfree(newVarName);
}
+
return varPtr;
+
+ #undef VAR_NAME_BUF_SIZE
}
/*
***************
*** 969,975 ****
Tcl_GetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
! 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
* bits. */
--- 979,985 ----
Tcl_GetVar(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. */
int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
* bits. */
***************
*** 1004,1010 ****
Tcl_GetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
! 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. */
--- 1014,1020 ----
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. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
***************
*** 1048,1054 ****
Tcl_GetVar2Ex(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
! 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. */
--- 1058,1064 ----
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. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
***************
*** 1159,1165 ****
register Var *varPtr; /* The variable to be read.*/
Var *arrayPtr; /* NULL for scalar variables, pointer to
* the containing array otherwise. */
! 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. */
--- 1169,1175 ----
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. */
***************
*** 1291,1297 ****
Tcl_SetVar(interp, varName, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
! 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,
--- 1301,1307 ----
Tcl_SetVar(interp, varName, newValue, flags)
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,
***************
*** 1332,1338 ****
Tcl_SetVar2(interp, part1, part2, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
! 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
--- 1342,1348 ----
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. */
CONST char *part2; /* Name of an element within an array, or
***************
*** 1405,1411 ****
Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be found. */
! 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. */
--- 1415,1421 ----
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. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
***************
*** 1516,1522 ****
* to be looked up. */
register Var *varPtr;
Var *arrayPtr;
! 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. */
--- 1526,1532 ----
* 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 *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
***************
*** 1772,1778 ****
* to be found. */
Var *varPtr;
Var *arrayPtr;
! 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
--- 1782,1788 ----
* 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 *part2; /* If non-null, points to an object holding
***************
*** 1877,1883 ****
Tcl_UnsetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
! 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
--- 1887,1893 ----
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. */
int flags; /* OR-ed combination of any of
***************
*** 1912,1918 ****
Tcl_UnsetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
! 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
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
--- 1922,1928 ----
Tcl_UnsetVar2(interp, part1, part2, flags)
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
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
***************
*** 2124,2130 ****
Tcl_TraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
! char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits, including any
* of TCL_TRACE_READS, TCL_TRACE_WRITES,
--- 2134,2140 ----
Tcl_TraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
! CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits, including any
* of TCL_TRACE_READS, TCL_TRACE_WRITES,
***************
*** 2163,2169 ****
Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
! char *part1; /* Name of scalar variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
--- 2173,2179 ----
Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
! CONST char *part1; /* Name of scalar variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
***************
*** 2241,2247 ****
void
Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits describing
* current trace, including any of
--- 2251,2257 ----
void
Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits describing
* current trace, including any of
***************
*** 2275,2281 ****
void
Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
--- 2285,2291 ----
void
Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! CONST char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
***************
*** 2386,2392 ****
ClientData
Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
--- 2396,2402 ----
ClientData
Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
***************
*** 2421,2427 ****
ClientData
Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
--- 2431,2437 ----
ClientData
Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
! CONST char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
***************
*** 3581,3587 ****
* to be looked up. */
CONST char *frameName; /* Name of the frame containing the source
* variable, such as "1" or "#0". */
! char *varName; /* Name of a variable in interp to link to.
* May be either a scalar name or an
* element in an array. */
CONST char *localName; /* Name of link variable. */
--- 3591,3597 ----
* 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. */
CONST char *localName; /* Name of link variable. */
***************
*** 3618,3624 ****
* for error messages too. */
CONST char *frameName; /* Name of the frame containing the source
* variable, such as "1" or "#0". */
! char *part1;
CONST char *part2; /* Two parts of source variable name to
* link to. */
CONST char *localName; /* Name of link variable. */
--- 3628,3634 ----
* 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 *localName; /* Name of link variable. */
***************
*** 4058,4064 ****
* isn't an element of an array. */
Var *varPtr; /* Variable whose traces are to be
* invoked. */
! char *part1;
CONST char *part2; /* Variable's two-part name. */
int flags; /* Flags passed to trace procedures:
* indicates what's happening to variable,
--- 4068,4074 ----
* isn't an element of an array. */
Var *varPtr; /* Variable whose traces are to be
* invoked. */
! CONST char *part1;
CONST char *part2; /* Variable's two-part name. */
int flags; /* Flags passed to trace procedures:
* indicates what's happening to variable,
***************
*** 4071,4077 ****
{
register VarTrace *tracePtr;
ActiveVarTrace active;
! char *result, *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
--- 4081,4088 ----
{
register VarTrace *tracePtr;
ActiveVarTrace active;
! char *result;
! CONST char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
***************
*** 4111,4121 ****
p--;
if (*p == ')') {
int offset = (openParen - part1);
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
! part2 = Tcl_DStringValue(&nameCopy) + offset + 1;
! part1 = Tcl_DStringValue(&nameCopy);
! part1[offset] = 0;
copiedName = 1;
}
break;
--- 4122,4134 ----
p--;
if (*p == ')') {
int offset = (openParen - part1);
+ char *newPart1;
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
! newPart1 = Tcl_DStringValue(&nameCopy);
! newPart1[offset] = 0;
! part1 = newPart1;
! part2 = newPart1 + offset + 1;
copiedName = 1;
}
break;
***************
*** 4727,4733 ****
static void
DeleteArray(iPtr, arrayName, varPtr, flags)
Interp *iPtr; /* Interpreter containing array. */
! char *arrayName; /* Name of array (used for trace
* callbacks). */
Var *varPtr; /* Pointer to variable structure. */
int flags; /* Flags to pass to CallVarTraces:
--- 4740,4746 ----
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 CallVarTraces:
***************
*** 4886,4892 ****
Var *
TclVarTraceExists(interp, varName)
Tcl_Interp *interp; /* The interpreter */
! char *varName; /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
--- 4899,4905 ----
Var *
TclVarTraceExists(interp, varName)
Tcl_Interp *interp; /* The interpreter */
! CONST char *varName; /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
