* generic/tclVar.c:

	* generic/tclEnv.c: Moved the "array set" C level code into a
	common routine (TclArraySet).  The TclSetupEnv routine now uses
	this API to create an env array w/ no elements.

	* generic/tclEnv.c:
	* generic/tclWinInit.h:
	* generic/tclUnixInit.h:
	* generic/tclInt.h: Made the Env module I18N compliant.  Changed the
	FindVariable routine to TclpFindVariable, that now does a case
	insensitive string comparison on Windows, and not on UNIX. [Bug:
	1299, 1500]

9 files changed, 485 insertions, 211 deletions

diff --git a/ChangeLog b/ChangeLog
index a4b48b6..5dac30f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+1999-04-06    <surles@scriptics.com>
+
+	* generic/tclVar.c: 
+	* generic/tclEnv.c: Moved the "array set" C level code into a
+	common routine (TclArraySet).  The TclSetupEnv routine now uses
+	this API to create an env array w/ no elements.
+
+	* generic/tclEnv.c:
+	* generic/tclWinInit.h:
+	* generic/tclUnixInit.h:
+	* generic/tclInt.h: Made the Env module I18N compliant.  Changed the
+	FindVariable routine to TclpFindVariable, that now does a case
+	insensitive string comparison on Windows, and not on UNIX. [Bug:
+	1299, 1500]
+
 1999-04-05    <stanton@scriptics.com>
 
 	* tests/io.test: Minor test cleanup.
diff --git a/changes b/changes
index cc467f7..d38e2d2 100644
--- a/changes
+++ b/changes
@@ -1,6 +1,6 @@
 Recent user-visible changes to Tcl:
 
-RCS: @(#) $Id: changes,v 1.1.2.27 1999/04/06 05:50:26 welch Exp $
+RCS: @(#) $Id: changes,v 1.1.2.28 1999/04/06 19:06:51 surles Exp $
 
 1. No more [command1] [command2] construct for grouping multiple
 commands on a single command line.
@@ -4291,5 +4291,19 @@ OS/390 and BSD/OS 4.*. (stanton)
 4/5/99 (bug fix) Fixed crash in the clock command that occurred
 with negative time values in timezones east of GMT. (stanton)
 
+4/6/99 (bug fix) Moved the "array set" C level code into a common
+routine (TclArraySet).  The TclSetupEnv routine now uses this API to
+create an env array w/ no elements.  This fixes the bug caused when
+every environ varaible is removed, and the Tcl env variable is
+synched.  If no environ vars existed, the Tcl env var would never be
+created. (surles)
+
+4/6/99 (bug fix) Made the Env module I18N compliant. (surles)
+
+4/6/99 (bug fix) Changed the FindVariable routine to TclpFindVariable,
+that now does a case insensitive string comparison on Windows, and not
+on UNIX. (surles)
+
+
 --------------- Released 8.1b3, April 6, 1999 ----------------------
 
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 2b64b1f..89484c4 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEnv.c,v 1.1.2.5 1998/12/12 01:36:56 lfb Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.1.2.6 1999/04/06 19:06:53 surles Exp $
  */
 
 #include "tclInt.h"
@@ -40,8 +40,6 @@ static int environSize = 0;	/* Non-zero means that the environ array was
 static char *		EnvTraceProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, char *name1, char *name2,
 			    int flags));
-static int		FindVariable _ANSI_ARGS_((CONST char *name,
-			    int *lengthPtr));
 static void		ReplaceString _ANSI_ARGS_((CONST char *oldStr,
 			    char *newStr));
 void			TclSetEnv _ANSI_ARGS_((CONST char *name,
@@ -77,46 +75,59 @@ TclSetupEnv(interp)
     Tcl_Interp *interp;		/* Interpreter whose "env" array is to be
 				 * managed. */
 {
-    char *p, *p2;
-    Tcl_DString nameString, valueString;
+    Tcl_DString envString;
+    char *p1, *p2;
     int i;
 
     /*
-     * Store the environment variable values into the interpreter's
-     * "env" array, and arrange for us to be notified on future
-     * writes and unsets to that array.
+     * Synchronize the values in the environ array with the contents
+     * of the Tcl "env" variable.  To do this:
+     *    1) Remove the trace that fires when the "env" var is unset.
+     *    2) Unset the "env" variable.
+     *    3) If there are no environ variables, create an empty "env"
+     *       array.  Otherwise populate the array with current values.
+     *    4) Add a trace that synchronizes the "env" array.
      */
-
-    (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
-
-    Tcl_MutexLock(&envMutex);
-    for (i = 0; ; i++) {
-	p = environ[i];
-	if (p == NULL) {
-	    break;
-	}
-	p2 = strchr(p, '=');
-	if (p2 == NULL) {
-	    /*
-	     * This condition doesn't seem like it should ever happen,
-	     * but it does seem to happen occasionally under some
-	     * versions of Solaris; ignore the entry.
-	     */
-
-	    continue;
+    
+    Tcl_UntraceVar2(interp, "env", (char *) NULL,
+	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
+	    (ClientData) NULL);
+    
+    Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 
+    
+    if (environ[0] == NULL) {
+	Tcl_Obj *varNamePtr;
+	
+	varNamePtr = Tcl_NewStringObj("env", -1);
+	Tcl_IncrRefCount(varNamePtr);
+	TclArraySet(interp, varNamePtr, NULL);	
+	Tcl_DecrRefCount(varNamePtr);
+    } else {
+	Tcl_MutexLock(&envMutex);
+	for (i = 0; environ[i] != NULL; i++) {
+	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
+	    p2 = strchr(p1, '=');
+	    if (p2 == NULL) {
+		/*
+		 * This condition seem to happen occasionally under some
+		 * versions of Solaris; ignore the entry.
+		 */
+		
+		continue;
+	    }
+	    p2++;
+	    p2[-1] = '\0';
+	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);	
+	    Tcl_DStringFree(&envString);
 	}
-	Tcl_ExternalToUtfDString(NULL, p, p2 - p, &nameString);
-	Tcl_ExternalToUtfDString(NULL, p2 + 1, -1, &valueString);
-	Tcl_SetVar2(interp, "env", Tcl_DStringValue(&nameString),
-                Tcl_DStringValue(&valueString), TCL_GLOBAL_ONLY);
-	Tcl_DStringFree(&nameString);
-	Tcl_DStringFree(&valueString);
+	Tcl_MutexUnlock(&envMutex);
     }
-    Tcl_MutexUnlock(&envMutex);
 
     Tcl_TraceVar2(interp, "env", (char *) NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc, (ClientData) NULL);
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
+	    (ClientData) NULL);
 }
 
 /*
@@ -142,12 +153,13 @@ TclSetupEnv(interp)
 
 void
 TclSetEnv(name, value)
-    CONST char *name;		/* Nname of variable whose value is to be
-				 * set (native). */
-    CONST char *value;		/* New value for variable (native). */
+    CONST char *name;		/* Name of variable whose value is to be
+				 * set (UTF-8). */
+    CONST char *value;		/* New value for variable (UTF-8). */
 {
+    Tcl_DString envString;
     int index, length, nameLength;
-    char *p, *oldValue;
+    char *p, *p2, *oldValue;
 
     /*
      * Figure out where the entry is going to go.  If the name doesn't
@@ -156,7 +168,8 @@ TclSetEnv(name, value)
      */
 
     Tcl_MutexLock(&envMutex);
-    index = FindVariable(name, &length);
+    index = TclpFindVariable(name, &length);
+
     if (index == -1) {
 #ifndef USE_PUTENV
 	if ((length + 2) > environSize) {
@@ -178,6 +191,8 @@ TclSetEnv(name, value)
 	oldValue = NULL;
 	nameLength = strlen(name);
     } else {
+	char *env;
+
 	/*
 	 * Compare the new value to the existing value.  If they're
 	 * the same then quit immediately (e.g. don't rewrite the
@@ -186,32 +201,47 @@ TclSetEnv(name, value)
 	 * of the same value among the interpreters.
 	 */
 
-	if (strcmp(value, environ[index] + length + 1) == 0) {
+	env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
+	if (strcmp(value, (env + length + 1)) == 0) {
+	    Tcl_DStringFree(&envString);
 	    Tcl_MutexUnlock(&envMutex);
 	    return;
 	}
+	Tcl_DStringFree(&envString);
+
 	oldValue = environ[index];
 	nameLength = length;
     }
 	
 
     /*
-     * Create a new entry.
+     * Create a new entry.  Build a complete UTF string that contains
+     * a "name=value" pattern.  Then convert the string to the native
+     * encoding, and set the environ array value.
      */
 
     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
     strcpy(p, name);
     p[nameLength] = '=';
     strcpy(p+nameLength+1, value);
+    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
+    ckfree(p);
+    
 
+#ifdef USE_PUTENV
     /*
      * Update the system environment.
      */
 
-#ifdef USE_PUTENV
-    putenv(p);
-    index = FindVariable(name, &length);
+    putenv(p2);
+    index = TclpFindVariable(name, &length);
 #else
+    /*
+     * Copy the native string to heap memory.
+     */
+    
+    p = (char *) ckalloc((unsigned) (strlen(p2) + 1));
+    strcpy(p, p2);
     environ[index] = p;
 #endif
 
@@ -222,10 +252,11 @@ TclSetEnv(name, value)
      */
 
     if (environ[index] != p) {
-	ckfree(p);
+	Tcl_DStringFree(&envString);
     } else {
 	ReplaceString(oldValue, p);
     }
+
     Tcl_MutexUnlock(&envMutex);
 }
 
@@ -257,6 +288,7 @@ Tcl_PutEnv(string)
     CONST char *string;		/* Info about environment variable in the
 				 * form NAME=value. (native) */
 {
+    Tcl_DString nameString;   
     int nameLength;
     char *name, *value;
 
@@ -265,23 +297,24 @@ Tcl_PutEnv(string)
     }
 
     /*
-     * Separate the string into name and value parts, then call
-     * TclSetEnv to do all of the real work.
+     * First convert the native string to UTF.  Then separate the
+     * string into name and value parts, and call TclSetEnv to do
+     * all of the real work.
      */
 
-    value = strchr(string, '=');
+    name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
+    value = strchr(name, '=');
     if (value == NULL) {
 	return 0;
     }
-    nameLength = value - string;
+    nameLength = value - name;
     if (nameLength == 0) {
 	return 0;
     }
-    name = (char *) ckalloc((unsigned) nameLength+1);
-    memcpy((VOID *) name, (VOID *) string, (size_t) nameLength);
-    name[nameLength] = 0;
+
+    value[0] = '\0';
     TclSetEnv(name, value+1);
-    ckfree(name);
+    Tcl_DStringFree(&nameString);
     return 0;
 }
 
@@ -307,18 +340,19 @@ Tcl_PutEnv(string)
 
 void
 TclUnsetEnv(name)
-    CONST char *name;		/* Name of variable to remove (native). */
+    CONST char *name;		/* Name of variable to remove (UTF-8). */
 {
     char *oldValue;
     int length, index;
 #ifdef USE_PUTENV
+    Tcl_DString envString;
     char *string;
 #else
     char **envPtr;
 #endif
 
     Tcl_MutexLock(&envMutex);
-    index = FindVariable(name, &length);
+    index = TclpFindVariable(name, &length);
 
     /*
      * First make sure that the environment variable exists to avoid
@@ -345,8 +379,23 @@ TclUnsetEnv(name)
     memcpy((VOID *) string, (VOID *) name, (size_t) length);
     string[length] = '=';
     string[length+1] = '\0';
-    putenv(string);
+    
+    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
     ckfree(string);
+    string = Tcl_DStringValue(&envString);
+    putenv(string);
+
+    /*
+     * Watch out for versions of putenv that copy the string (e.g. VC++).
+     * In this case we need to free the string immediately.  Otherwise
+     * update the string in the cache.
+     */
+
+    if (environ[index] != string) {
+	Tcl_DStringFree(&envString);
+    } else {
+	ReplaceString(oldValue, string);
+    }
 #else
     for (envPtr = environ+index+1; ; envPtr++) {
 	envPtr[-1] = *envPtr;
@@ -354,13 +403,8 @@ TclUnsetEnv(name)
 	    break;
 	}
     }
-#endif
-
-    /*
-     * Replace the old value in the cache.
-     */
-
     ReplaceString(oldValue, NULL);
+#endif
 
     Tcl_MutexUnlock(&envMutex);
 }
@@ -394,19 +438,25 @@ TclGetEnv(name, valuePtr)
 				 * stored. */
 {
     int length, index;
-    Tcl_DString nameString;
     char *result;
 
     Tcl_MutexLock(&envMutex);
-    Tcl_UtfToExternalDString(NULL, name, -1, &nameString);
-
-    index = FindVariable(Tcl_DStringValue(&nameString), &length);
-    Tcl_DStringFree(&nameString);
-    
+    index = TclpFindVariable(name, &length);
     result = NULL;
-    if ((index != -1) &&  (*(environ[index]+length) == '=')) {
-	result = Tcl_ExternalToUtfDString(NULL, environ[index]+length+1,
-		-1, valuePtr);
+    if (index != -1) {
+	Tcl_DString envStr;
+	
+	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
+	result += length;
+	if (*result == '=') {
+	    result++;
+	    Tcl_DStringInit(valuePtr);
+	    Tcl_DStringAppend(valuePtr, result, -1);
+	    result = Tcl_DStringValue(valuePtr);
+	} else {
+	    result = NULL;
+	}
+	Tcl_DStringFree(&envStr);
     }
     Tcl_MutexUnlock(&envMutex);
     return result;
@@ -445,20 +495,31 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
     int flags;			/* Indicates what's happening. */
 {
     /*
+     * For array traces, let TclSetupEnv do all the work.
+     */
+
+    if (flags & TCL_TRACE_ARRAY) {
+	TclSetupEnv(interp);
+	return NULL;
+    }
+
+    /*
+     * If name2 is NULL, then return and do nothing.
+     */
+     
+    if (name2 == NULL) {
+	return NULL;
+    }
+
+    /*
      * If a value is being set, call TclSetEnv to do all of the work.
      */
 
     if (flags & TCL_TRACE_WRITES) {
-	Tcl_DString nameString, valueString;
 	char *value;
 	
 	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
-	Tcl_UtfToExternalDString(NULL, name2, -1, &nameString);
-	Tcl_UtfToExternalDString(NULL, value, -1, &valueString);
-	TclSetEnv(Tcl_DStringValue(&nameString),
-		Tcl_DStringValue(&valueString));
-	Tcl_DStringFree(&nameString);
-	Tcl_DStringFree(&valueString);
+	TclSetEnv(name2, value);
     }
 
     /*
@@ -478,24 +539,11 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
     }
 
     /*
-     * For array traces, let TclSetupEnv do all the work.
-     */
-
-    if (flags & TCL_TRACE_ARRAY) {
-	TclSetupEnv(interp);
-    }
-
-
-    /*
      * For unset traces, let TclUnsetEnv do all the work.
      */
 
-    if ((flags & TCL_TRACE_UNSETS) && (name2 != NULL)) {
-	Tcl_DString nameString;
-
-	Tcl_UtfToExternalDString(NULL, name2, -1, &nameString);
-	TclUnsetEnv(Tcl_DStringValue(&nameString));
-	Tcl_DStringFree(&nameString);
+    if (flags & TCL_TRACE_UNSETS) {
+	TclUnsetEnv(name2);
     }
     return NULL;
 }
@@ -580,51 +628,6 @@ ReplaceString(oldStr, newStr)
 /*
  *----------------------------------------------------------------------
  *
- * FindVariable --
- *
- *	Locate the entry in environ for a given name.
- *
- * Results:
- *	The return value is the index in environ of an entry with the
- *	name "name", or -1 if there is no such entry.   The integer at
- *	*lengthPtr is filled in with the length of name (if a matching
- *	entry is found) or the length of the environ array (if no matching
- *	entry is found).
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FindVariable(name, lengthPtr)
-    CONST char *name;		/* Name of desired environment variable
-				 * (native). */
-    int *lengthPtr;		/* Used to return length of name (for
-				 * successful searches) or number of non-NULL
-				 * entries in environ (for unsuccessful
-				 * searches). */
-{
-    int i;
-    register CONST char *p1, *p2;
-
-    for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
-	for (p2 = name; *p2 == *p1; p1++, p2++) {
-	    /* NULL loop body. */
-	}
-	if ((*p1 == '=') && (*p2 == '\0')) {
-	    *lengthPtr = p2-name;
-	    return i;
-	}
-    }
-    *lengthPtr = i;
-    return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclFinalizeEnvironment --
  *
  *	This function releases any storage allocated by this module
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6bb1042..c615d9d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.1.2.19 1999/04/06 03:13:16 redman Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.1.2.20 1999/04/06 19:06:53 surles Exp $
  */
 
 #ifndef _TCLINT
@@ -1556,6 +1556,8 @@ EXTERN int		TclAccess _ANSI_ARGS_((CONST char *path,
 EXTERN int		TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc));
 EXTERN int		TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc));
 EXTERN void		TclAllocateFreeObjects _ANSI_ARGS_((void));
+EXTERN int		TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
 EXTERN int		TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
 			    int numPids, Tcl_Pid *pidPtr,
 			    Tcl_Channel errorChan));
@@ -1725,6 +1727,8 @@ EXTERN void		TclpFinalizeThreadDataKey _ANSI_ARGS_((
 			    Tcl_ThreadDataKey *keyPtr));
 EXTERN char *		TclpFindExecutable _ANSI_ARGS_((
 			    CONST char *argv0));
+EXTERN int		TclpFindVariable _ANSI_ARGS_((CONST char *name,
+			    int *lengthPtr));
 EXTERN void		TclpFree _ANSI_ARGS_((char *ptr));
 EXTERN unsigned long	TclpGetClicks _ANSI_ARGS_((void));
 EXTERN Tcl_Channel	TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
diff --git a/generic/tclVar.c b/generic/tclVar.c
index ebf45f1..d63d20f 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.1.2.4 1999/02/10 23:31:20 stanton Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.1.2.5 1999/04/06 19:06:54 surles Exp $
  */
 
 #include "tclInt.h"
@@ -2847,8 +2847,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 	  ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
 	  ARRAY_STARTSEARCH}; 
     static char *arrayOptions[] = {"anymore", "donesearch", "exists",
-				   "get", "names", "nextelement", "set", "size", "startsearch", 
-				   (char *) NULL};
+				   "get", "names", "nextelement", "set",
+				   "size", "startsearch", (char *) NULL};
 
     Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
@@ -3101,73 +3101,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 	    break;
 	}
         case ARRAY_SET: {
-	    Tcl_Obj **elemPtrs;
-	    int listLen, i, result;
-	    
 	    if (objc != 4) {
 	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
 		return TCL_ERROR;
 	    }
-	    result = Tcl_ListObjGetElements(interp, objv[3], &listLen, 
-                    &elemPtrs);
-	    if (result != TCL_OK) {
-	        return result;
-	    }
-	    if (listLen & 1) {
-	        Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-                        "list must have an even number of elements", -1);
-		return TCL_ERROR;
-	    }
-	    if (listLen > 0) {
-		for (i = 0;  i < listLen;  i += 2) {
-		    if (Tcl_ObjSetVar2(interp, objv[2], elemPtrs[i],
-			    elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
-			result = TCL_ERROR;
-			break;
-		    }
-		}
-		return result;
-	    }
-
-	    /*
-	     * The list is empty make sure we have an array, or create
-	     * one if necessary.
-	     */
-	    
-	    if (varPtr != NULL) {
-		if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
-		    /*
-		     * Already an array, done.
-		     */
-		    
-		    return TCL_OK;
-                }
-		if (TclIsVarArrayElement(varPtr) ||
-			!TclIsVarUndefined(varPtr)) {
-		    /*
-		     * Either an array element, or a scalar: lose!
-		     */
-		    
-		    VarErrMsg(interp, varName, (char *)NULL, "array set",
-                            needArray);
-		    return TCL_ERROR;
-                }
-	    } else {
-		/*
-		 * Create variable for new array.
-		 */
-		
-		varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
-			/*createPart1*/ 1, /*createPart2*/ 0,
-			&arrayPtr);
-	    }
-	    TclSetVarArray(varPtr);
-	    TclClearVarUndefined(varPtr);
-	    varPtr->value.tablePtr =
-		(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-	    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
-	    return TCL_OK;
+	    return(TclArraySet(interp, objv[2], objv[3]));
 	}
         case ARRAY_SIZE: {
 	    Tcl_HashSearch search;
@@ -3235,6 +3173,102 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * 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.
+ *
+ * Results:
+ *	A standard Tcl result object.
+ *
+ * Side effects:
+ *	A variable will be created if one does not already exist.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclArraySet(interp, arrayNameObj, arrayElemObj)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    Tcl_Obj *arrayNameObj;	/* The array name. */
+    Tcl_Obj *arrayElemObj;	/* The array elements list.  If this is
+				 * NULL, create an empty array. */
+{
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj **elemPtrs;
+    int result, elemLen, i;
+    char *varName;
+    
+    varName = TclGetString(arrayNameObj);
+    varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+            /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+    if (arrayElemObj != NULL) {
+	result = Tcl_ListObjGetElements(interp, arrayElemObj,
+		&elemLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (elemLen & 1) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		    "list must have an even number of elements", -1);
+	    return TCL_ERROR;
+	}
+	if (elemLen > 0) {
+	    for (i = 0;  i < elemLen;  i += 2) {
+		if (Tcl_ObjSetVar2(interp, arrayNameObj, elemPtrs[i],
+			elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
+		    result = TCL_ERROR;
+		    break;
+		}
+	    }
+	    return result;
+	}
+    }
+    
+    /*
+     * The list is empty make sure we have an array, or create
+     * one if necessary.
+     */
+    
+    if (varPtr != NULL) {
+	if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+	    /*
+	     * Already an array, done.
+	     */
+	    
+	    return TCL_OK;
+	}
+	if (TclIsVarArrayElement(varPtr) ||
+		!TclIsVarUndefined(varPtr)) {
+	    /*
+	     * Either an array element, or a scalar: lose!
+	     */
+	    
+	    VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
+	    return TCL_ERROR;
+	}
+    } else {
+	/*
+	 * Create variable for new array.
+	 */
+	
+	varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
+	        /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+    }
+    TclSetVarArray(varPtr);
+    TclClearVarUndefined(varPtr);
+    varPtr->value.tablePtr =
+	(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * MakeUpvar --
  *
  *	This procedure does all of the work of the "global" and "upvar"
diff --git a/tests/env.test b/tests/env.test
index 2d1e2a7..fa2d86c 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: env.test,v 1.1.2.6 1999/03/24 02:49:04 hershey Exp $
+# RCS: @(#) $Id: env.test,v 1.1.2.7 1999/04/06 19:06:56 surles Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -171,6 +171,68 @@ test env-4.5 {unsetting international environment variables} {execCommandExists}
     set result
 } "\ub6=\ua7"
 
+test env-5.0 {corner cases - set a value, it should exist} {} {
+    set temp [lindex [array names env] end]
+    set x env($temp)
+    set env($temp) a
+    set result [set env($temp)]
+    set env($temp) $x
+    set result
+} {a}
+test env-5.1 {corner cases - remove one elem at a time} {} {
+    # When no environment variables exist, the env var will
+    # contain no entries.  The "array names" call synchs up
+    # the C-level environ array with the Tcl level env array.
+    # Make sure an empty Tcl array is created.
+
+    set x [array get env]
+    foreach e [array names env] {
+	unset env($e)
+    }
+    set result [catch {array names env}]
+    array set env $x
+    set result
+} {0}
+test env-5.2 {corner cases - unset the env array} {} {
+    # Unsetting a variable in an interp detaches the C-level
+    # traces from the Tcl "env" variable.
+
+    interp create i 
+    i eval { unset env }
+    i eval { set env(THIS_SHOULDNT_EXIST) a}
+    set result [info exist env(THIS_SHOULDNT_EXIST)]
+    interp delete i
+    set result
+} {0}
+test env-5.3 {corner cases - unset the env in master should unset child} {} {
+    # Variables deleted in a master interp should be deleted in
+    # child interp too.
+
+    interp create i 
+    i eval { set env(THIS_SHOULD_EXIST) a}
+    set result [set env(THIS_SHOULD_EXIST)]
+    unset env(THIS_SHOULD_EXIST)
+    lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
+    interp delete i
+    set result
+} {a 1}
+test env-5.4 {corner cases - unset the env array} {} {
+    # The info exist command should be in synch with the env array.
+
+    interp create i 
+    i eval { set env(THIS_SHOULD_EXIST) a}
+    set     result [info exists env(THIS_SHOULD_EXIST)]
+    lappend result [set env(THIS_SHOULD_EXIST)]
+    lappend result [info exists env(THIS_SHOULD_EXIST)]
+    interp delete i
+    set result
+} {1 a 1}
+test env-5.5 {corner cases - cannot have null entries on Windows} {winOnly} {
+    set env() a
+    catch {set env()}
+} {1}
+
+
 # Restore the environment variables at the end of the test.
 
 foreach name [array names env] {
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 680d996..99651f7 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixInit.c,v 1.1.2.12 1999/03/30 23:56:19 stanton Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.1.2.13 1999/04/06 19:06:56 surles Exp $
  */
 
 #include "tclInt.h"
@@ -489,6 +489,64 @@ TclpSetVariables(interp)
 /*
  *----------------------------------------------------------------------
  *
+ * TclpFindVariable --
+ *
+ *	Locate the entry in environ for a given name.  On Unix this 
+ *	routine is case sensetive, on Windows this matches mioxed case.
+ *
+ * Results:
+ *	The return value is the index in environ of an entry with the
+ *	name "name", or -1 if there is no such entry.   The integer at
+ *	*lengthPtr is filled in with the length of name (if a matching
+ *	entry is found) or the length of the environ array (if no matching
+ *	entry is found).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpFindVariable(name, lengthPtr)
+    CONST char *name;		/* Name of desired environment variable
+				 * (native). */
+    int *lengthPtr;		/* Used to return length of name (for
+				 * successful searches) or number of non-NULL
+				 * entries in environ (for unsuccessful
+				 * searches). */
+{
+    int i, result = -1;
+    register CONST char *env, *p1, *p2;
+    Tcl_DString envString;
+
+    Tcl_DStringInit(&envString);
+    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+	p2 = name;
+
+	for (; *p2 == *p1; p1++, p2++) {
+	    /* NULL loop body. */
+	}
+	if ((*p1 == '=') && (*p2 == '\0')) {
+	    *lengthPtr = p2 - name;
+	    result = i;
+	    goto done;
+	}
+	
+	Tcl_DStringFree(&envString);
+    }
+    
+    *lengthPtr = i;
+
+    done:
+    Tcl_DStringFree(&envString);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Init --
  *
  *	This procedure is typically invoked by Tcl_AppInit procedures
diff --git a/win/makefile.vc b/win/makefile.vc
index 252627e..fc8df04 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -6,7 +6,7 @@
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# RCS: @(#) $Id: makefile.vc,v 1.1.2.23 1999/04/02 23:48:33 redman Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.1.2.24 1999/04/06 19:06:57 surles Exp $
 
 # Does not depend on the presence of any environment variables in
 # order to compile tcl; all needed information is derived from 
@@ -61,7 +61,7 @@ NODEBUG = 1
 #				needed when using Purify.
 #
 #DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_TCLALLOC=0
+DEBUGDEFINES = -DUSE_TCLALLOC=0
 
 ######################################################################
 # Do not modify below this line
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index cc0bc85..b388557 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinInit.c,v 1.1.2.8 1999/03/12 23:29:22 surles Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.1.2.9 1999/04/06 19:06:57 surles Exp $
  */
 
 #include "tclWinInt.h"
@@ -578,6 +578,90 @@ TclpSetVariables(interp)
 /*
  *----------------------------------------------------------------------
  *
+ * TclpFindVariable --
+ *
+ *	Locate the entry in environ for a given name.  On Unix this 
+ *	routine is case sensetive, on Windows this matches mioxed case.
+ *
+ * Results:
+ *	The return value is the index in environ of an entry with the
+ *	name "name", or -1 if there is no such entry.   The integer at
+ *	*lengthPtr is filled in with the length of name (if a matching
+ *	entry is found) or the length of the environ array (if no matching
+ *	entry is found).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpFindVariable(name, lengthPtr)
+    CONST char *name;		/* Name of desired environment variable
+				 * (UTF-8). */
+    int *lengthPtr;		/* Used to return length of name (for
+				 * successful searches) or number of non-NULL
+				 * entries in environ (for unsuccessful
+				 * searches). */
+{
+    int i, length, result = -1;
+    register CONST char *env, *p1, *p2;
+    char *envUpper, *nameUpper;
+    Tcl_DString envString;
+
+    /*
+     * Convert the name to all upper case for the case insensitive
+     * comparison.
+     */
+
+    length = strlen(name);
+    nameUpper = (char *) ckalloc((unsigned) length+1);
+    memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
+    Tcl_UtfToUpper(nameUpper);
+    
+    Tcl_DStringInit(&envString);
+    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+	/*
+	 * Chop the env string off after the equal sign, then Convert
+	 * the name to all upper case, so we do not have to convert
+	 * all the characters after the equal sign.
+	 */
+	
+	envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+	p1 = strchr(envUpper, '=');
+	if (p1 == NULL) {
+	    continue;
+	}
+	length = p1 - envUpper;
+	Tcl_DStringSetLength(&envString, length+1);
+	Tcl_UtfToUpper(envUpper);
+
+	p1 = envUpper;
+	p2 = nameUpper;
+	for (; *p2 == *p1; p1++, p2++) {
+	    /* NULL loop body. */
+	}
+	if ((*p1 == '=') && (*p2 == '\0')) {
+	    *lengthPtr = length;
+	    result = i;
+	    goto done;
+	}
+	
+	Tcl_DStringFree(&envString);
+    }
+    
+    *lengthPtr = i;
+
+    done:
+    Tcl_DStringFree(&envString);
+    ckfree(nameUpper);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Init --
  *
  *	This procedure is typically invoked by Tcl_AppInit procedures