* generic/tclStringObj.c: fixed Tcl_AppendResultVA so it only

	iterates once over the va_list (avoiding a memcpy of it,
	which is not portable).

	* generic/tclEnv.c: fixed possible ABR error in environ array

	* tests/scan.test:
	* generic/tclScan.c: added support for use of inline scan,
	XPG3 currently not included

	* tests/incr.test:
	* tests/set.test:
	* generic/tclCompCmds.c: fixed improper bytecode handling of
	'eval {set array($unknownvar) 5}' (also for incr)

	* win/tclWinTest.c: added testvolumetype command, as atime is
	completely ignored for Windows FAT file systems
	* win/tclWinPort.h: added sys/utime.h to includes
	* unix/tclUnixPort.h: added utime.h to includes
	* doc/file.n:
	* tests/cmdAH.test:
	* generic/tclCmdAH.c: added time arguments to atime and mtime
	file command methods (support 'touch' functionality)

6 files changed, 231 insertions, 49 deletions

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index b86ea42..3e4de89 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -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: tclCmdAH.c,v 1.9 1999/09/21 04:20:39 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.10 1999/10/29 03:03:59 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -827,13 +827,41 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
     switch ((enum options) index) {
     	case FILE_ATIME: {
 	    struct stat buf;
-	    
-	    if (objc != 3) {
-		goto only3Args;
+	    char *fileName;
+	    struct utimbuf tval;
+
+	    if ((objc < 3) || (objc > 4)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+		return TCL_ERROR;
 	    }
 	    if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	    if (objc == 4) {
+		if (Tcl_GetLongFromObj(interp, objv[3],
+			(long*)(&buf.st_atime)) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		tval.actime = buf.st_atime;
+		tval.modtime = buf.st_mtime;
+		fileName = Tcl_GetString(objv[2]);
+		if (utime(fileName, &tval) != 0) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			    "could not set access time for file \"",
+			    fileName, "\": ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		    return TCL_ERROR;
+		}
+		/*
+		 * Do another stat to ensure that the we return the
+		 * new recognized atime - hopefully the same as the
+		 * one we sent in.  However, fs's like FAT don't
+		 * even know what atime is.
+		 */
+		if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
 	    Tcl_SetLongObj(resultPtr, (long) buf.st_atime);
 	    return TCL_OK;
 	}
@@ -986,13 +1014,41 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 	}
 	case FILE_MTIME: {
 	    struct stat buf;
-	    
-	    if (objc != 3) {
-		goto only3Args;
+	    char *fileName;
+	    struct utimbuf tval;
+
+	    if ((objc < 3) || (objc > 4)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+		return TCL_ERROR;
 	    }
 	    if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	    if (objc == 4) {
+		if (Tcl_GetLongFromObj(interp, objv[3],
+			(long*)(&buf.st_mtime)) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		tval.actime = buf.st_atime;
+		tval.modtime = buf.st_mtime;
+		fileName = Tcl_GetString(objv[2]);
+		if (utime(fileName, &tval) != 0) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			    "could not set modification time for file \"",
+			    fileName, "\": ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		    return TCL_ERROR;
+		}
+		/*
+		 * Do another stat to ensure that the we return the
+		 * new recognized atime - hopefully the same as the
+		 * one we sent in.  However, fs's like FAT don't
+		 * even know what atime is.
+		 */
+		if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
 	    Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
 	    return TCL_OK;
 	}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index bd00b56..86ed11e 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.21 1999/10/21 02:16:21 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.22 1999/10/29 03:03:59 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1109,7 +1109,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			&index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		Tcl_SetByteArrayObj(resultPtr, &string1[index], 1);
+		Tcl_SetByteArrayObj(resultPtr,
+			(unsigned char *)(&string1[index]), 1);
 	    } else {
 		string1 = Tcl_GetStringFromObj(objv[2], &length1);
 		
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9566a2f..5577bf1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.3 1999/08/19 02:59:08 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.4 1999/10/29 03:04:00 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1341,7 +1341,16 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+    /*
+     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+     * curly braces surround the variable name.
+     * This really matters for array elements to handle things like
+     *    set {x($foo)} 5
+     * which raises an undefined var error if we are not careful here.
+     * This goes with the hack in TclCompileSetCmd.
+     */
+    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+	    (varTokenPtr->start[0] != '{')) {
 	/*
 	 * A simple variable name. Divide it up into "name" and "elName"
 	 * strings. If it is not a local variable, look it up at runtime.
@@ -1600,8 +1609,18 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+    /*
+     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+     * curly braces surround the variable name.
+     * This really matters for array elements to handle things like
+     *    set {x($foo)} 5
+     * which raises an undefined var error if we are not careful here.
+     * This goes with the hack in TclCompileIncrCmd.
+     */
+    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+	    (varTokenPtr->start[0] != '{')) {
 	simpleVarName = 1;
+
 	name = varTokenPtr[1].start;
 	nameChars = varTokenPtr[1].size;
 	/* last char is ')' => potential array reference */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index f601da5..49984c9 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.5 1999/10/13 00:32:17 hobbs Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.6 1999/10/29 03:04:00 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -251,7 +251,7 @@ TclSetEnv(name, value)
      * update the string in the cache.
      */
 
-    if (environ[index] == p) {
+    if ((index != -1) && (environ[index] == p)) {
 	ReplaceString(oldValue, p);
     }
 
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 92b192c..868239a 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.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: tclScan.c,v 1.2 1999/04/16 00:46:53 stanton Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.3 1999/10/29 03:04:00 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -54,7 +54,7 @@ static char *	BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));
 static int	CharInSet _ANSI_ARGS_((CharSet *cset, int ch));
 static void	ReleaseCharSet _ANSI_ARGS_((CharSet *cset));
 static int	ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
-		    int numVars));
+		    int numVars, int *totalVars));
 
 /*
  *----------------------------------------------------------------------
@@ -255,17 +255,21 @@ ReleaseCharSet(cset)
  */
 
 static int
-ValidateFormat(interp, format, numVars)
+ValidateFormat(interp, format, numVars, totalSubs)
     Tcl_Interp *interp;		/* Current interpreter. */
     char *format;		/* The format string. */
     int numVars;		/* The number of variables passed to the
 				 * scan command. */
+    int *totalSubs;		/* The number of variables that will be
+				 * required. */
 {
+#define STATIC_LIST_SIZE 16
     int gotXpg, gotSequential, value, i, flags;
     char *end;
     Tcl_UniChar ch;
-    int *nassign = (int*)ckalloc(sizeof(int) * numVars);
-    int objIndex;
+    int staticAssign[STATIC_LIST_SIZE];
+    int *nassign = staticAssign;
+    int objIndex, nspace = STATIC_LIST_SIZE;
 
     /*
      * Initialize an array that records the number of times a variable
@@ -273,9 +277,14 @@ ValidateFormat(interp, format, numVars)
      * a variable is multiply assigned or left unassigned.
      */
 
-    for (i = 0; i < numVars; i++) {
+    if (numVars > nspace) {
+	nassign = (int*)ckalloc(sizeof(int) * numVars);
+	nspace = numVars;
+    }
+    for (i = 0; i < nspace; i++) {
 	nassign[i] = 0;
     }
+    //memset(nassign, 0, nspace * sizeof(int));
 
     objIndex = gotXpg = gotSequential = 0;
 
@@ -350,7 +359,7 @@ ValidateFormat(interp, format, numVars)
 	    format += Tcl_UtfToUniChar(format, &ch);
 	}
 
-	if (!(flags & SCAN_SUPPRESS) && objIndex >= numVars) {
+	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
 	    goto badIndex;
 	}
 
@@ -415,6 +424,26 @@ ValidateFormat(interp, format, numVars)
 	    }
 	}
 	if (!(flags & SCAN_SUPPRESS)) {
+	    if (objIndex >= nspace) {
+		/*
+		 * Expand the nassign buffer
+		 */
+		nspace += STATIC_LIST_SIZE;
+		if (nassign == staticAssign) {
+		    nassign = (void *)ckalloc(nspace * sizeof(int));
+		    for (i = 0; i < STATIC_LIST_SIZE; ++i) {
+			nassign[i] = staticAssign[i];
+		    }
+		} else {
+		    nassign = (void *)ckrealloc((void *)nassign,
+			    nspace * sizeof(int));
+		}
+		for (i = nspace-STATIC_LIST_SIZE; i < nspace; i++) {
+		    nassign[i] = 0;
+		}
+		//memset((VOID *) nassign[nspace-STATIC_LIST_SIZE], 0,
+		//	STATIC_LIST_SIZE * sizeof(int));
+	    }
 	    nassign[objIndex]++;
 	    objIndex++;
 	}
@@ -424,17 +453,25 @@ ValidateFormat(interp, format, numVars)
      * Verify that all of the variable were assigned exactly once.
      */
 
+    if (numVars == 0) {
+	numVars = objIndex;
+    }
+    if (totalSubs) {
+	*totalSubs = numVars;
+    }
     for (i = 0; i < numVars; i++) {
 	if (nassign[i] > 1) {
 	    Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
 	    goto error;
 	} else if (nassign[i] == 0) {
-	    Tcl_SetResult(interp, "variable is not assigend by any conversion specifiers", TCL_STATIC);
+	    Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
 	    goto error;
 	}
     }
 
-    ckfree((char *)nassign);
+    if (nassign != staticAssign) {
+	ckfree((char *)nassign);
+    }
     return TCL_OK;
 
     badIndex:
@@ -448,8 +485,11 @@ ValidateFormat(interp, format, numVars)
     }
 
     error:
-    ckfree((char *)nassign);
+    if (nassign != staticAssign) {
+	ckfree((char *)nassign);
+    }
     return TCL_ERROR;
+#undef STATIC_LIST_SIZE
 }
 
 /*
@@ -478,7 +518,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     char *format;
-    int numVars, nconversions;
+    int numVars, nconversions, totalVars = -1;
     int objIndex, offset, i, value, result, code;
     char *string, *end, *baseString;
     char op = 0;
@@ -487,7 +527,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     size_t width;
     long (*fn)() = NULL;
     Tcl_UniChar ch, sch;
-    Tcl_Obj **objs, *objPtr;
+    Tcl_Obj **objs = NULL, *objPtr = NULL;
     int flags;
     char buf[513];			  /* Temporary buffer to hold scanned
 					   * number strings before they are
@@ -506,17 +546,19 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
      * Check for errors in the format string.
      */
     
-    if (ValidateFormat(interp, format, numVars) == TCL_ERROR) {
+    if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
 	return TCL_ERROR;
     }
 
     /*
      * Allocate space for the result objects.
      */
-    
-    objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * numVars);
-    for (i = 0; i < numVars; i++) {
-	objs[i] = NULL;
+
+    if (totalVars > 0) {
+	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
+	for (i = 0; i < totalVars; i++) {
+	    objs[i] = NULL;
+	}
     }
 
     string = Tcl_GetStringFromObj(objv[1], NULL);
@@ -1009,24 +1051,57 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     result = 0;
     code = TCL_OK;
 
-    for (i = 0; i < numVars; i++) {
-	if (objs[i] != NULL) {
-	    result++;
-	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"couldn't set variable \"",
-			Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
-		code = TCL_ERROR;
+    if (numVars) {
+	/*
+	 * In this case, variables were specified (classic scan)
+	 */
+	for (i = 0; i < totalVars; i++) {
+	    if (objs[i] != NULL) {
+		result++;
+		if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,
+			objs[i], 0) == NULL) {
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			    "couldn't set variable \"",
+			    Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
+		    code = TCL_ERROR;
+		}
+		Tcl_DecrRefCount(objs[i]);
+	    }
+	}
+    } else {
+	/*
+	 * Here no vars were specified, we want a list returned (inline scan)
+	 */
+	objPtr = Tcl_NewObj();
+	for (i = 0; i < totalVars; i++) {
+	    if (objs[i] != NULL) {
+		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
+		Tcl_DecrRefCount(objs[i]);
+	    } else {
+		/*
+		 * More %-specifiers than matching chars, so we
+		 * just spit out empty strings for these
+		 */
+		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
 	    }
-	    Tcl_DecrRefCount(objs[i]);
 	}
     }
     ckfree((char*) objs);
     if (code == TCL_OK) {
 	if (underflow && (nconversions == 0)) {
-	    result = -1;
+	    if (numVars) {
+		objPtr = Tcl_NewIntObj(-1);
+	    } else {
+		if (objPtr) {
+		    Tcl_SetListObj(objPtr, 0, NULL);
+		} else {
+		    objPtr = Tcl_NewObj();
+		}
+	    }
+	} else if (numVars) {
+	    objPtr = Tcl_NewIntObj(result);
 	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+	Tcl_SetObjResult(interp, objPtr);
     }
     return code;
 }
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index bc18fb3..f9c9589 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.13 1999/09/02 16:26:34 hobbs Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.14 1999/10/29 03:04:00 hobbs Exp $ */
 
 #include "tclInt.h"
 
@@ -1170,10 +1170,14 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     Tcl_Obj *objPtr;		/* Points to the object to append to. */
     va_list argList;		/* Variable argument list. */
 {
+#define STATIC_LIST_SIZE 16
     String *stringPtr;
-    va_list tmpArgList;
     int newLength, oldLength;
     register char *string, *dst;
+    char *static_list[STATIC_LIST_SIZE];
+    char **args = static_list;
+    int nargs_space = STATIC_LIST_SIZE;
+    int nargs, i;
 
     if (Tcl_IsShared(objPtr)) {
 	panic("Tcl_AppendStringsToObj called with shared object");
@@ -1188,17 +1192,33 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
      * (notably OS/390) the argList is an array so we need to use memcpy.
      */
 
-    memcpy ((VOID *) &tmpArgList, (VOID *) &argList, sizeof (tmpArgList));
+    nargs = 0;
     newLength = oldLength = objPtr->length;
     while (1) {
-	string = va_arg(tmpArgList, char *);
+	string = va_arg(argList, char *);
 	if (string == NULL) {
 	    break;
 	}
+ 	if (nargs >= nargs_space) {
+ 	    /* 
+ 	     * Expand the args buffer
+ 	     */
+ 	    nargs_space += STATIC_LIST_SIZE;
+ 	    if (args == static_list) {
+ 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
+ 		for (i = 0; i < nargs; ++i) {
+ 		    args[i] = static_list[i];
+ 		}
+ 	    } else {
+ 		args = (void *)ckrealloc((void *)args,
+			nargs_space * sizeof(char *));
+ 	    }
+ 	}
 	newLength += strlen(string);
+	args[nargs++] = string;
     }
     if (newLength == oldLength) {
-	return;
+	goto done;
     }
 
     stringPtr = GET_STRING(objPtr);
@@ -1222,8 +1242,8 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
      */
 
     dst = objPtr->bytes + oldLength;
-    while (1) {
-	string = va_arg(argList, char *);
+    for (i = 0; i < nargs; ++i) {
+ 	string = args[i];
 	if (string == NULL) {
 	    break;
 	}
@@ -1245,6 +1265,17 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
 	*dst = 0;
     }
     objPtr->length = newLength;
+
+    done:
+    /*
+     * If we had to allocate a buffer from the heap, 
+     * free it now.
+     */
+ 
+    if (args != static_list) {
+     	ckfree((void *)args);
+    }
+#undef STATIC_LIST_SIZE
 }
 
 /*