diff options
author | vasiljevic <zv@archiware.com> | 2004-06-22 11:55:31 (GMT) |
---|---|---|
committer | vasiljevic <zv@archiware.com> | 2004-06-22 11:55:31 (GMT) |
commit | b9273c1f802ff63672d83bb1de3667270e663919 (patch) | |
tree | 46ef860f18e83f0c6be6b62f91faa2f921d51da5 | |
parent | 1dc7dd38fb40ca56d2e36b80e22ff1c1e68e0b0c (diff) | |
download | tcl-b9273c1f802ff63672d83bb1de3667270e663919.zip tcl-b9273c1f802ff63672d83bb1de3667270e663919.tar.gz tcl-b9273c1f802ff63672d83bb1de3667270e663919.tar.bz2 |
Corrected Tcl Bug #770053
-rw-r--r-- | ChangeLog | 15 | ||||
-rw-r--r-- | generic/tclEvent.c | 96 | ||||
-rw-r--r-- | generic/tclInt.h | 7 | ||||
-rw-r--r-- | tests/unixNotfy.test | 16 | ||||
-rw-r--r-- | unix/tclUnixNotfy.c | 4 | ||||
-rw-r--r-- | unix/tclUnixThrd.c | 4 | ||||
-rw-r--r-- | win/tclWinThrd.c | 6 |
7 files changed, 128 insertions, 20 deletions
@@ -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(¬ifierMutex); if (notifierCount == 0) { - if (Tcl_CreateThread(¬ifierThread, NotifierThreadProc, NULL, + if (TclpThreadCreate(¬ifierThread, 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() */ |