Bug fixes for threaded Tcl on NT with single and dual CPUs. Still some

open issues, this code is a little more stable though.


FossilOrigin-Name: f4fa2a7ba1bdb443e65019bd05fcdd45b1518fd6

7 files changed, 52 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index b1a53db..d15c5d6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+1999-07-26    <redman@scriptics.com>
+
+ 	* tests/tcltest.test:  Need to close the new core file, there
+	seems to be a hang in threaded WinNT if the file isn't closed.
+	Open issue, need to fix that hang.
+
+	* tests/httpold.test:  Add time delay in response from Http server
+	so that test cases can properly detect timeout conditions with
+	threads enabled on multi-CPU WinNT.
+
+	* tests/winFCmd.test:  Test case winFcmd-1.33 was looking for
+	c:\windows, which may not exist.  Instead, create a new directory
+	on c:\ and use it for the test.
+
+	* win/tclWinConsole.c:
+	* win/tclWinPipe.c:
+	* win/tclWinSock.c:  Fix terminating helper threads by holding any
+	mutexes from the primary thread while waiting for the helper
+	thread to terminate.  Without these changes, the test suite hangs
+	on WinNT with 2 CPUs and threads enabled.  Open issue, seems to be
+	a sporadic hang on dual CPU systems still (very rare).
+
 1999-07-26  Jennifer Hom  <jenn@scriptics.com>
 
 	* tests/tcltest.test:
diff --git a/tests/httpold.test b/tests/httpold.test
index 50bb152..3e8aa76 100644
--- a/tests/httpold.test
+++ b/tests/httpold.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: httpold.test,v 1.5 1999/06/26 03:54:14 jenn Exp $
+# RCS: @(#) $Id: httpold.test,v 1.6 1999/07/27 01:42:23 redman Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -79,6 +79,7 @@ proc httpdRead { sock } {
 	if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
 		$line x data(proto) data(url) data(query)] {
 	    set data(state) mime
+	    after 10
 	    httpd_log $sock Query $line
 	} else {
 	    httpdError $sock 400
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 74c5b1b..6229d46 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -10,7 +10,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.1 1999/07/26 17:59:12 jenn Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.2 1999/07/27 01:42:23 redman Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -252,7 +252,8 @@ makeFile {
     package require tcltest
     namespace import ::tcltest::*
     test makecore {make a core file} {
-	open core w
+	set f [open core w]
+	close $f
     } {}
     ::tcltest::cleanupTests
     return
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 249c3bd..61dc707 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.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: winFCmd.test,v 1.7 1999/07/01 17:36:20 jenn Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.8 1999/07/27 01:42:24 redman Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -297,9 +297,11 @@ test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
 	{pcOnly exdev} {
     file mkdir d:/td1
     testchmod 000 d:/td1
-    set msg [list [catch {testfile mv c:/windows d:/td1} msg] $msg]
+    file mkdir c:/tf1
+    set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg]
     set msg "$msg [file writable d:/td1]"
     file delete d:/td1
+    file delete -force c:/tf1
     set msg
 } {1 EXDEV 0}
 test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {pcOnly} {
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index bd50859..7d62a5a 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.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: tclWinConsole.c,v 1.2 1999/04/16 00:48:07 stanton Exp $
+ * RCS: @(#) $Id: tclWinConsole.c,v 1.3 1999/07/27 01:42:25 redman Exp $
  */
 
 #include "tclWinInt.h"
@@ -486,7 +486,6 @@ ConsoleCloseProc(
 
 	Tcl_MutexLock(&consoleMutex);
 	TerminateThread(consolePtr->readThread, 0);
-	Tcl_MutexUnlock(&consoleMutex);
 
 	/*
 	 * Wait for the thread to terminate.  This ensures that we are
@@ -494,6 +493,8 @@ ConsoleCloseProc(
 	 */
 
 	WaitForSingleObject(consolePtr->readThread, INFINITE);
+	Tcl_MutexUnlock(&consoleMutex);
+
 	CloseHandle(consolePtr->readThread);
 	CloseHandle(consolePtr->readable);
 	CloseHandle(consolePtr->startReader);
@@ -522,7 +523,6 @@ ConsoleCloseProc(
 
 	Tcl_MutexLock(&consoleMutex);
 	TerminateThread(consolePtr->writeThread, 0);
-	Tcl_MutexUnlock(&consoleMutex);
 
 	/*
 	 * Wait for the thread to terminate.  This ensures that we are
@@ -530,6 +530,8 @@ ConsoleCloseProc(
 	 */
 
 	WaitForSingleObject(consolePtr->writeThread, INFINITE);
+	Tcl_MutexUnlock(&consoleMutex);
+
 	CloseHandle(consolePtr->writeThread);
 	CloseHandle(consolePtr->writable);
 	CloseHandle(consolePtr->startWriter);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 6d182fa..565445e 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.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: tclWinPipe.c,v 1.6 1999/05/21 18:28:45 redman Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.7 1999/07/27 01:42:25 redman Exp $
  */
 
 #include "tclWinInt.h"
@@ -2164,7 +2164,6 @@ PipeClose2Proc(
 
 	    Tcl_MutexLock(&pipeMutex);
 	    TerminateThread(pipePtr->readThread, 0);
-	    Tcl_MutexUnlock(&pipeMutex);
 
 	    /*
 	     * Wait for the thread to terminate.  This ensures that we are
@@ -2172,6 +2171,8 @@ PipeClose2Proc(
 	     */
 
 	    WaitForSingleObject(pipePtr->readThread, INFINITE);
+	    Tcl_MutexUnlock(&pipeMutex);
+
 	    CloseHandle(pipePtr->readThread);
 	    CloseHandle(pipePtr->readable);
 	    CloseHandle(pipePtr->startReader);
@@ -2206,8 +2207,6 @@ PipeClose2Proc(
 
 	    Tcl_MutexLock(&pipeMutex);
 	    TerminateThread(pipePtr->writeThread, 0);
-	    Tcl_MutexUnlock(&pipeMutex);
-
 
 	    /*
 	     * Wait for the thread to terminate.  This ensures that we are
@@ -2215,6 +2214,9 @@ PipeClose2Proc(
 	     */
 
 	    WaitForSingleObject(pipePtr->writeThread, INFINITE);
+	    Tcl_MutexUnlock(&pipeMutex);
+
+
 	    CloseHandle(pipePtr->writeThread);
 	    CloseHandle(pipePtr->writable);
 	    CloseHandle(pipePtr->startWriter);
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 7b63168..688df20 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.13 1999/07/22 23:45:53 redman Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.14 1999/07/27 01:42:25 redman Exp $
  */
 
 #include "tclWinInt.h"
@@ -583,7 +583,16 @@ SocketThreadExitHandler(clientData)
 	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr->socketThread != NULL) {
+	Tcl_MutexLock(&socketMutex);
 	TerminateThread(tsdPtr->socketThread, 0);
+
+	/*
+	 * Wait for the thread to terminate.  This ensures that we are
+	 * completely cleaned up before we leave this function. 
+	 */
+	
+	WaitForSingleObject(tsdPtr->socketThread, INFINITE);
+	Tcl_MutexUnlock(&socketMutex);
     }
     if (tsdPtr->hwnd != NULL) {
 	DestroyWindow(tsdPtr->hwnd);