summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvasiljevic <zv@archiware.com>2004-06-22 11:55:31 (GMT)
committervasiljevic <zv@archiware.com>2004-06-22 11:55:31 (GMT)
commitb9273c1f802ff63672d83bb1de3667270e663919 (patch)
tree46ef860f18e83f0c6be6b62f91faa2f921d51da5
parent1dc7dd38fb40ca56d2e36b80e22ff1c1e68e0b0c (diff)
downloadtcl-b9273c1f802ff63672d83bb1de3667270e663919.zip
tcl-b9273c1f802ff63672d83bb1de3667270e663919.tar.gz
tcl-b9273c1f802ff63672d83bb1de3667270e663919.tar.bz2
Corrected Tcl Bug #770053
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclEvent.c96
-rw-r--r--generic/tclInt.h7
-rw-r--r--tests/unixNotfy.test16
-rw-r--r--unix/tclUnixNotfy.c4
-rw-r--r--unix/tclUnixThrd.c4
-rw-r--r--win/tclWinThrd.c6
7 files changed, 128 insertions, 20 deletions
diff --git a/ChangeLog b/ChangeLog
index fa6bf00..626e49c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2004-06-22 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclEvent.c:
+ * generic/tclInt.h:
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixThrd.c:
+ * win/tclWinThrd.c: [Bug #770053]. See bug report for
+ more information about what it does.
+
+ * tests/unixNotfy.test: rewritten to use tcltest::threadReap
+ to gracefully wait for the test thread to exit. Otherwise
+ we got a race condition with main thread exiting before the
+ test thread. This exposed the long-standing Tcl lib issue
+ with resource garbage-collection on application exit.
+
2004-06-21 Mo DeJong <mdejong@users.sourceforge.net>
* win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler,
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index eacf41b..c6d7d65 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.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: tclEvent.c,v 1.28.2.3 2004/05/06 01:17:41 davygrvy Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.28.2.4 2004/06/22 11:55:35 vasiljevic Exp $
*/
#include "tclInt.h"
@@ -104,6 +104,17 @@ static Tcl_ThreadDataKey dataKey;
*/
static char *tclLibraryPathStr = NULL;
+
+#ifdef TCL_THREADS
+
+typedef struct {
+ Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+} ThreadClientData;
+static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
+ ClientData clientData));
+#endif
+
/*
* Prototypes for procedures referenced only in this file:
*/
@@ -720,6 +731,7 @@ TclInitSubsystems(argv0)
* interesting happens so we can use the allocators in the
* implementation of self-initializing locks.
*/
+
#if USE_TCLALLOC
TclInitAlloc(); /* process wide mutex init */
#endif
@@ -728,10 +740,10 @@ TclInitSubsystems(argv0)
#endif
TclpInitPlatform(); /* creates signal handler(s) */
- TclInitObjSubsystem(); /* register obj types, create mutexes */
+ TclInitObjSubsystem(); /* register obj types, create mutexes */
TclInitIOSubsystem(); /* inits a tsd key (noop) */
TclInitEncodingSubsystem(); /* process wide encoding init */
- TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
+ TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
}
TclpInitUnlock();
}
@@ -1148,3 +1160,81 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
return TCL_OK;
}
+
+#ifdef TCL_THREADS
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * NewThreadProc --
+ *
+ * Bootstrap function of a new Tcl thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Initializes Tcl notifier for the current thread.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static Tcl_ThreadCreateType
+NewThreadProc(ClientData clientData)
+{
+ ThreadClientData *cdPtr;
+ ClientData threadClientData;
+ Tcl_ThreadCreateProc *threadProc;
+
+ TCL_TSD_INIT(&dataKey);
+
+ cdPtr = (ThreadClientData*)clientData;
+ threadProc = cdPtr->proc;
+ threadClientData = cdPtr->clientData;
+ Tcl_Free((char*)clientData); /* Allocated in Tcl_CreateThread() */
+
+ TclInitNotifier();
+
+ (*threadProc)(threadClientData);
+}
+#endif
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThread --
+ *
+ * This procedure creates a new thread. This actually belongs
+ * to the tclThread.c file but since we use some private
+ * data structures local to this file, it is placed here.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is
+ * returned in a parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+ int stackSize; /* Size of stack for the new thread */
+ int flags; /* Flags controlling behaviour of
+ * the new thread */
+{
+#ifdef TCL_THREADS
+ ThreadClientData *cdPtr;
+
+ cdPtr = (ThreadClientData*)Tcl_Alloc(sizeof(ThreadClientData));
+ cdPtr->proc = proc;
+ cdPtr->clientData = clientData;
+
+ return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
+ stackSize, flags);
+#else
+ return TCL_ERROR;
+#endif /* TCL_THREADS */
+}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7282343..95129b6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.118.2.5 2004/05/06 01:02:58 davygrvy Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.6 2004/06/22 11:55:35 vasiljevic Exp $
*/
#ifndef _TCLINT
@@ -1764,6 +1764,11 @@ EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr));
EXTERN void TclpThreadDataKeySet _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr, VOID *data));
+EXTERN int TclpThreadCreate _ANSI_ARGS_((
+ Tcl_ThreadId *idPtr,
+ Tcl_ThreadCreateProc proc,
+ ClientData clientData,
+ int stackSize, int flags));
EXTERN void TclpThreadExit _ANSI_ARGS_((int status));
EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index d39828e..27f5160 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.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: unixNotfy.test,v 1.11.2.2 2003/10/06 13:55:39 dgp Exp $
+# RCS: @(#) $Id: unixNotfy.test,v 1.11.2.3 2004/06/22 11:55:36 vasiljevic Exp $
# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
@@ -80,10 +80,9 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
fileevent $f writable {set x 1}
vwait x
close $f
- testthread create "after 500
- testthread send [testthread id] {set x ok}
- testthread exit"
+ testthread create "testthread send [testthread id] {set x ok}"
vwait x
+ threadReap
set x
} \
-result {ok} \
@@ -104,11 +103,10 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
close $f1
vwait y
close $f2
- testthread create "after 500
- testthread send [testthread id] {set x ok}
- testthread exit"
- vwait x
- set x
+ testthread create "testthread send [testthread id] {set x ok}"
+ vwait x
+ threadReap
+ set x
} \
-result {ok} \
-cleanup {
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 0cad280..4449b47 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.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: tclUnixNotfy.c,v 1.11.2.2 2003/07/16 22:09:48 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixNotfy.c,v 1.11.2.3 2004/06/22 11:55:36 vasiljevic Exp $
*/
#include "tclInt.h"
@@ -208,7 +208,7 @@ Tcl_InitNotifier()
Tcl_MutexLock(&notifierMutex);
if (notifierCount == 0) {
- if (Tcl_CreateThread(&notifierThread, NotifierThreadProc, NULL,
+ if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
panic("Tcl_InitNotifier: unable to start notifier thread");
}
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 04eacf4..78ca385 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -66,7 +66,7 @@ static pthread_mutex_t *allocLockPtr = &allocLock;
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateThread --
+ * TclpThreadCreate --
*
* This procedure creates a new thread.
*
@@ -81,7 +81,7 @@ static pthread_mutex_t *allocLockPtr = &allocLock;
*/
int
-Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
Tcl_ThreadCreateProc proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 558cee4..f7fe507 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.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: tclWinThrd.c,v 1.24.2.5 2004/05/06 01:03:14 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinThrd.c,v 1.24.2.6 2004/06/22 11:55:36 vasiljevic Exp $
*/
#include "tclWinInt.h"
@@ -115,7 +115,7 @@ typedef struct WinCondition {
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateThread --
+ * TclpThreadCreate --
*
* This procedure creates a new thread.
*
@@ -130,7 +130,7 @@ typedef struct WinCondition {
*/
int
-Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
Tcl_ThreadCreateProc proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */