Fix hange with socket code (win32) with threads enabled, fixed

the semaphores for threads disabled.  Fixed calling of tcltest
in Makefile.in (win32) and fixed safe-6.3 for threads enabled.

4 files changed, 38 insertions, 20 deletions

diff --git a/tests/safe.test b/tests/safe.test
index b453543..48782cf 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -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: safe.test,v 1.7 1999/06/26 20:55:12 rjohnson Exp $
+# RCS: @(#) $Id: safe.test,v 1.8 1999/07/22 23:45:52 redman Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -180,6 +180,10 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
 	    [lsearch $r "debug"] != -1} {
 	set r [lreplace $r 1 1]
     }
+    set threaded [lsearch $r "threaded"]
+    if {$threaded != -1} {
+	set r [lreplace $r $threaded $threaded]
+    }
     set r
 } {byteOrder platform}
 
diff --git a/win/Makefile.in b/win/Makefile.in
index 0c9f350..c60db65 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.16 1999/07/20 00:11:56 hershey Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.17 1999/07/22 23:45:53 redman Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -102,6 +102,8 @@ GENERIC_DIR_NATIVE 	= $(shell cygpath $(PATHTYPE) '$(GENERIC_DIR)')
 WIN_DIR_NATIVE	   	= $(shell cygpath $(PATHTYPE) '$(WIN_DIR)')
 ROOT_DIR_NATIVE	   	= $(shell cygpath $(PATHTYPE) '$(ROOT_DIR)')
 
+LIBRARY_DIR   = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' )
+
 DLLSUFFIX		= @DLLSUFFIX@
 LIBSUFFIX		= @LIBSUFFIX@
 EXESUFFIX		= @EXESUFFIX@
@@ -443,13 +445,13 @@ install-libraries:
 install-doc:
 
 test: binaries $(TCLTEST)
-	TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	| ./$(CAT32)
 
 # Useful target to launch a built tcltest with the proper path,...
 runtest: tcltest
-	@TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	    ./tcltest
 
 depend:
diff --git a/win/makefile.vc b/win/makefile.vc
index 4d77b51..169311d 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.41 1999/07/22 21:50:57 redman Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.42 1999/07/22 23:45:53 redman Exp $
 
 # Does not depend on the presence of any environment variables in
 # order to compile tcl; all needed information is derived from 
@@ -48,7 +48,7 @@ MACHINE	= IX86
 #THREADDEFINES = -DTCL_THREADS=1
 
 # Set NODEBUG to 0 to compile with symbols
-NODEBUG = 0
+NODEBUG = 1
 
 # The following defines can be used to control the amount of debugging
 # code that is added to the compilation.
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 112c552..7b63168 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.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: tclWinSock.c,v 1.12 1999/07/21 21:28:59 redman Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.13 1999/07/22 23:45:53 redman Exp $
  */
 
 #include "tclWinInt.h"
@@ -23,6 +23,7 @@ static int initialized = 0;
 static int  hostnameInitialized = 0;
 static char hostname[255];	/* This buffer should be big enough for
                                  * hostname plus domain name. */
+
 TCL_DECLARE_MUTEX(socketMutex)
 
 /*
@@ -157,6 +158,7 @@ typedef struct ThreadSpecificData {
     HANDLE readyEvent;      /* Event indicating that a socket event is ready.
 			     * Also used to indicate that the socketThread has
 			     * been initialized and has started. */
+    HANDLE socketListLock;  /* Win32 Event to lock the socketList */
     SocketInfo *socketList;
 } ThreadSpecificData;
 
@@ -448,6 +450,7 @@ InitSockets()
 	tsdPtr->threadId = Tcl_GetCurrentThread();
 	
 	tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+	tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
 	tsdPtr->socketThread = CreateThread(NULL, 8000, SocketThread,
 		tsdPtr, 0, &id);
 	SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); 
@@ -463,12 +466,9 @@ InitSockets()
 	 * seconds.
 	 */
 	
-	Tcl_MutexUnlock(&socketMutex);
 	if (WaitForSingleObject(tsdPtr->readyEvent, 20000) == WAIT_TIMEOUT) {
-	    Tcl_MutexLock(&socketMutex);
 	    goto unloadLibrary;
 	}
-	Tcl_MutexLock(&socketMutex);
 
 	if (tsdPtr->hwnd == NULL) {
 	    goto unloadLibrary;
@@ -663,6 +663,7 @@ SocketSetupProc(data, flags)
      * Check to see if there is a ready socket.  If so, poll.
      */
 
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
 	    infoPtr = infoPtr->nextPtr) {
 	if (infoPtr->readyEvents & infoPtr->watchEvents) {
@@ -670,6 +671,7 @@ SocketSetupProc(data, flags)
 	    break;
 	}
     }
+    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
@@ -708,6 +710,7 @@ SocketCheckProc(data, flags)
      * events).
      */
 
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
 	    infoPtr = infoPtr->nextPtr) {
 	if ((infoPtr->readyEvents & infoPtr->watchEvents)
@@ -719,6 +722,7 @@ SocketCheckProc(data, flags)
 	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 	}
     }
+    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
@@ -762,13 +766,15 @@ SocketEventProc(evPtr, flags)
      * Find the specified socket on the socket list.
      */
 
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
 	    infoPtr = infoPtr->nextPtr) {
 	if (infoPtr->socket == eventPtr->socket) {
 	    break;
 	}
     }
-
+    SetEvent(tsdPtr->socketListLock);
+    
     /*
      * Discard events that have gone stale.
      */
@@ -934,6 +940,7 @@ TcpCloseProc(instanceData, interp)
      * Remove the socket from socketList.
      */
 
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 	if ((*nextPtrPtr) == infoPtr) {
@@ -941,7 +948,8 @@ TcpCloseProc(instanceData, interp)
 	    break;
 	}
     }
-
+    SetEvent(tsdPtr->socketListLock);
+    
     ckfree((char *) infoPtr);
     return errorCode;
 }
@@ -980,9 +988,11 @@ NewSocketInfo(socket)
     infoPtr->acceptProc = NULL;
     infoPtr->lastError = 0;
 
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     infoPtr->nextPtr = tsdPtr->socketList;
     tsdPtr->socketList = infoPtr;
-
+    SetEvent(tsdPtr->socketListLock);
+    
     return infoPtr;
 }
 
@@ -2102,11 +2112,9 @@ SocketThread(LPVOID arg)
 {
     MSG msg;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
-    
-    Tcl_MutexLock(&socketMutex);
+
     tsdPtr->hwnd = CreateWindowA("TclSocket", "TclSocket", 
 	    WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, NULL);
-    Tcl_MutexUnlock(&socketMutex);
 
     /*
      * Signal the main thread that the window has been created
@@ -2183,13 +2191,12 @@ SocketProc(hwnd, message, wParam, lParam)
 	    error = WSAGETSELECTERROR(lParam);
 	    socket = (SOCKET) wParam;
 
-	    Tcl_MutexLock(&socketMutex);
-	    
 	    /*
 	     * Find the specified socket on the socket list and update its
 	     * eventState flag.
 	     */
 	    
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 	    for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
 		 infoPtr = infoPtr->nextPtr) {
 		if (infoPtr->socket == socket) {
@@ -2248,7 +2255,7 @@ SocketProc(hwnd, message, wParam, lParam)
 		    break;
 		}
 	    }
-	    Tcl_MutexUnlock(&socketMutex);
+	    SetEvent(tsdPtr->socketListLock);
 	    break;
 	case SOCKET_SELECT:
 	    infoPtr = (SocketInfo *) lParam;
@@ -2295,22 +2302,27 @@ Tcl_GetHostName()
     WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
 
     Tcl_MutexLock(&socketMutex);
+    InitSockets();
+
     if (hostnameInitialized) {
 	Tcl_MutexUnlock(&socketMutex);
         return hostname;
     }
-
+    Tcl_MutexUnlock(&socketMutex);
+	
     if (TclpHasSockets(NULL) == TCL_OK) {
 	/*
 	 * INTL: bug
 	 */
 
 	if ((*winSock.gethostname)(hostname, sizeof(hostname)) == 0) {
+	    Tcl_MutexLock(&socketMutex);
 	    hostnameInitialized = 1;
 	    Tcl_MutexUnlock(&socketMutex);
 	    return hostname;
 	}
     }
+    Tcl_MutexLock(&socketMutex);
     length = sizeof(hostname);
     if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
 	/*