* unix/tclUnixNotfy.c: fixed event/io threading problems by

	making triggerPipe non-blocking

	* library/tcltest1.0/tcltest.tcl:
	* generic/tclThreadTest.c: fixed mem leaks in threads

	* generic/tclResult.c: fixed Tcl_AppendResultVA so it only
	iterates once over the va_list (avoiding a memcpy of it,
	which is not portable).

	* generic/regc_color.c: fixed mem leak and assertion, from HS

	* generic/tclCompile.c: removed savedChar trick that appeared to
	be causing a segv when the literal table was released

	* tests/string.test:
	* generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj
	when indexing into one (test case string-5.16) [Bug: 2871]

5 files changed, 136 insertions, 36 deletions

diff --git a/generic/regc_color.c b/generic/regc_color.c
index 000d0ea..5aed21c 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -97,7 +97,7 @@ struct colormap *cm;
 	cm->magic = 0;
 	if (NBYTS > 1)
 		cmtreefree(cm, cm->tree, 0);
-	for (i = 1; i < cm->max; i++)		/* skip WHITE */
+	for (i = 1; i <= cm->max; i++)		/* skip WHITE */
 		if (!UNUSEDCOLOR(&cm->cd[i])) {
 			cb = cm->cd[i].block;
 			if (cb != NULL)
@@ -456,7 +456,7 @@ struct state *rp;
 	color co;
 	color sco;
 
-	assert((uc & BYTMASK) == 0);
+	assert((uc % BYTTAB) == 0);
 
 	/* find its color block, making new pointer blocks as needed */
 	t = cm->tree;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 8758660..bd00b56 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.20 1999/09/21 04:20:40 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.21 1999/10/21 02:16:21 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1109,7 +1109,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			&index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		Tcl_SetStringObj(resultPtr, &string1[index], 1);
+		Tcl_SetByteArrayObj(resultPtr, &string1[index], 1);
 	    } else {
 		string1 = Tcl_GetStringFromObj(objv[2], &length1);
 		
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d83a9c1..7df3815 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.16 1999/08/19 02:59:09 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.17 1999/10/21 02:16:22 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1348,7 +1348,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
     JumpFixup jumpFixup;
     int maxDepth, doExprInline, range, numBytes, i, j, code;
     char *script;
-    char savedChar;
     int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
     int saveExprIsComparison = envPtr->exprIsComparison;
 
@@ -1370,10 +1369,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
 
 	script = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
-	savedChar = script[numBytes];
-	script[numBytes] = 0;
 	code = TclCompileExpr(interp, script, numBytes, envPtr);
-	script[numBytes] = savedChar;
 	return code;
     }
 	
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 2f18b51..663f47f 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.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: tclResult.c,v 1.3 1999/05/07 20:07:35 stanton Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.4 1999/10/21 02:16:22 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -455,10 +455,12 @@ Tcl_AppendResultVA (interp, argList)
 				 * return value. */
     va_list argList;		/* Variable argument list. */
 {
+#define STATIC_LIST_SIZE 16
     Interp *iPtr = (Interp *) interp;
-    va_list tmpArgList;
-    char *string;
-    int newSpace;
+    char *string, *static_list[STATIC_LIST_SIZE];
+    char **args = static_list;
+    int nargs_space = STATIC_LIST_SIZE;
+    int nargs, newSpace, i;
 
     /*
      * If the string result is empty, move the object result to the
@@ -472,17 +474,35 @@ Tcl_AppendResultVA (interp, argList)
     }
     
     /*
-     * Scan through all the arguments to see how much space is needed.
+     * Scan through all the arguments to see how much space is needed
+     * and save pointers to the arguments in the args array,
+     * reallocating as necessary.
      */
 
-    memcpy ((VOID *) &tmpArgList, (VOID *) &argList, sizeof (tmpArgList));
+    nargs = 0;
     newSpace = 0;
     while (1) {
-	string = va_arg(tmpArgList, char *);
+ 	string = va_arg(argList, char *);
 	if (string == NULL) {
 	    break;
 	}
-	newSpace += strlen(string);
+ 	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 *));
+ 	    }
+ 	}
+  	newSpace += strlen(string);
+	args[nargs++] = string;
     }
 
     /*
@@ -501,14 +521,21 @@ Tcl_AppendResultVA (interp, argList)
      * buffer.
      */
 
-    while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
-	    break;
-	}
-	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
-	iPtr->appendUsed += strlen(string);
+    for (i = 0; i < nargs; ++i) {
+ 	string = args[i];
+  	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+  	iPtr->appendUsed += strlen(string);
+    }
+ 
+    /*
+     * If we had to allocate a buffer from the heap, 
+     * free it now.
+     */
+ 
+    if (args != static_list) {
+     	ckfree((void *)args);
     }
+#undef STATIC_LIST_SIZE
 }
 
 /*
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index c24b059..113f327 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.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: tclThreadTest.c,v 1.3 1999/05/26 20:24:43 redman Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.4 1999/10/21 02:16:22 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -135,6 +135,9 @@ static void	ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
 static void	ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
 static int	ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask));
 static void	ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp));
+static void	ThreadFreeProc _ANSI_ARGS_((ClientData clientData));
+static int	ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr,
+	ClientData clientData));
 static void	ThreadExitProc _ANSI_ARGS_((ClientData clientData));
 
 
@@ -351,8 +354,7 @@ TclCreateThread(interp, script)
     ThreadCtrl ctrl;
     Tcl_ThreadId id;
 
-    ctrl.script = (char*)ckalloc( strlen(script) + 1 );
-    strcpy(ctrl.script, script);
+    ctrl.script = (char *) script;
     ctrl.condWait = NULL;
     ctrl.flags = 0;
 
@@ -413,10 +415,8 @@ NewThread(clientData)
 {
     ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    ThreadCtrl ctrl;
     int result;
-
-    ctrl = *ctrlPtr;
+    char *threadEvalScript;
 
     /*
      * Initialize the interpreter.  This should be more general.
@@ -432,7 +432,14 @@ NewThread(clientData)
 
     Tcl_MutexLock(&threadMutex);
     ListUpdateInner(tsdPtr);
-    Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
+    /*
+     * We need to keep a pointer to the alloc'ed mem of the script
+     * we are eval'ing, for the case that we exit during evaluation
+     */
+    threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+    strcpy(threadEvalScript, ctrlPtr->script);
+
+    Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
 
     /*
      * Notify the parent we are alive.
@@ -446,7 +453,7 @@ NewThread(clientData)
      */
 
     Tcl_Preserve((ClientData) tsdPtr->interp);
-    result = Tcl_Eval(tsdPtr->interp, ctrl.script);
+    result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
     if (result != TCL_OK) {
 	ThreadErrorProc(tsdPtr->interp);
     }
@@ -456,7 +463,6 @@ NewThread(clientData)
      */
 
     ListRemove(tsdPtr);
-    ckfree((char*)ctrl.script);
     Tcl_Release((ClientData) tsdPtr->interp);
     Tcl_DeleteInterp(tsdPtr->interp);
     Tcl_ExitThread(result);
@@ -676,7 +682,7 @@ TclThreadSend(interp, id, script, wait)
     threadEventPtr->script = ckalloc(strlen(script) + 1);
     strcpy(threadEventPtr->script, script);
     if (!wait) {
-	threadEventPtr->resultPtr = NULL;
+	resultPtr = threadEventPtr->resultPtr = NULL;
     } else {
 	resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
 	threadEventPtr->resultPtr = resultPtr;
@@ -802,7 +808,11 @@ ThreadEventProc(evPtr, mask)
     } else {
 	Tcl_Preserve((ClientData) interp);
 	Tcl_ResetResult(interp);
+	Tcl_CreateThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	code = Tcl_GlobalEval(interp, threadEventPtr->script);
+	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	result = Tcl_GetStringResult(interp);
 	if (code != TCL_OK) {
 	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
@@ -837,6 +847,65 @@ ThreadEventProc(evPtr, mask)
 /*
  *------------------------------------------------------------------------
  *
+ * ThreadFreeProc --
+ *
+ *    This is called from when we are exiting and memory needs
+ *    to be freed.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *	Clears up mem specified in ClientData
+ *
+ *------------------------------------------------------------------------
+ */
+     /* ARGSUSED */
+void
+ThreadFreeProc(clientData)
+    ClientData clientData;
+{
+    if (clientData) {
+	ckfree((char *) clientData);
+    }
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadDeleteEvent --
+ *
+ *    This is called from the ThreadExitProc to delete memory related
+ *    to events that we put on the queue.
+ *
+ * Results:
+ *    1 it was our event and we want it removed, 0 otherwise.
+ *
+ * Side effects:
+ *	It cleans up our events in the event queue for this thread.
+ *
+ *------------------------------------------------------------------------
+ */
+     /* ARGSUSED */
+int
+ThreadDeleteEvent(eventPtr, clientData)
+    Tcl_Event *eventPtr;		/* Really ThreadEvent */
+    ClientData clientData;		/* dummy */
+{
+    if (eventPtr->proc == ThreadEventProc) {
+	ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+	return 1;
+    }
+    /*
+     * If it was NULL, we were in the middle of servicing the event
+     * and it should be removed
+     */
+    return (eventPtr->proc == NULL);
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
  * ThreadExitProc --
  *
  *    This is called when the thread exits.  
@@ -852,13 +921,21 @@ ThreadEventProc(evPtr, mask)
  */
      /* ARGSUSED */
 void
-ThreadExitProc(dummy)
-    ClientData dummy;
+ThreadExitProc(clientData)
+    ClientData clientData;
 {
+    char *threadEvalScript = (char *) clientData;
     ThreadEventResult *resultPtr, *nextPtr;
     Tcl_ThreadId self = Tcl_GetCurrentThread();
 
     Tcl_MutexLock(&threadMutex);
+
+    if (threadEvalScript) {
+	ckfree((char *) threadEvalScript);
+	threadEvalScript = NULL;
+    }
+    Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
+
     for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
 	nextPtr = resultPtr->nextPtr;
 	if (resultPtr->srcThreadId == self) {