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;
