Index: generic/tclThread.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclThread.c,v
retrieving revision 1.7
diff -u -r1.7 tclThread.c
--- generic/tclThread.c	23 Apr 2004 07:21:36 -0000	1.7
+++ generic/tclThread.c	17 May 2004 20:58:28 -0000
@@ -494,7 +494,128 @@
     keyRecord.num = 0;
 #endif
 }
+#if 1 && defined(TCL_THREADS)
 
+/*
+ *-----------------------------------------------------------------------------
+ *
+ *  TclpAtforkLock --
+ *
+ * 	pthread_atfork callback called just before fork() in the
+ * 	parent process.  Locks mutexes which are subsequently unlocked
+ * 	in both the parent and child.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Locks mutexes.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+void
+TclpAtforkLock(void)
+{
+    Tcl_Mutex *mutexPtr;
+    int i;
+
+    /* locks must be held in locking order (if any) */
+    TclpMasterLock();
+    TclpInitLock();
+    for (i=0 ; i<mutexRecord.num ; i++) {
+	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
+	if (mutexPtr != NULL) {
+	    Tcl_MutexLock(mutexPtr);
+	}
+    }
+    Tcl_MutexLock(Tcl_GetAllocMutex());
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ *  TclpAtForkParent --
+ *
+ * 	This is the pthread_atfork callback in the parent process,
+ * 	after the fork.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Calls TclpAtforkUnlock to unlock mutexes and initialize the
+ *	notifier system.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+void TclpAtForkParent(void)
+{
+    TclpAtforkUnlock();
+    /* FIXME Hooks can go here. */
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ *  TclpAtForkChild --
+ *
+ * 	This is the pthread_atfork callback in the child process,
+ * 	after the fork.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Calls TclpAtforkUnlock to unlock mutexes and initialize the
+ *	notifier system.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+void TclpAtForkChild(void)
+{
+    TclpAtforkUnlock();
+    /* FIXME Hooks can go here. */
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ *  TclpAtforkUnlock --
+ *
+ * 	Unlocks mutexes locked in TclpAtforkLock, and starts the
+ * 	notifier subsystem with TclInitNotifier.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	TclInitNotifier creates a notifier thread.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+void
+TclpAtforkUnlock(void)
+{
+    Tcl_Mutex *mutexPtr;
+    int i;
+
+    /* locks must be released in same order as in atfork_lock() */
+    TclpMasterUnlock();
+    TclpInitUnlock();
+    for (i=0; i<mutexRecord.num ; i++) {
+	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
+	if (mutexPtr != NULL) {
+	    Tcl_MutexUnlock(mutexPtr);
+	}
+    }
+    Tcl_MutexUnlock(Tcl_GetAllocMutex());
+    TclInitNotifier();
+}
+#endif
 
 /*
  *----------------------------------------------------------------------
Index: tests/thread.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/thread.test,v
retrieving revision 1.10
diff -u -r1.10 thread.test
--- tests/thread.test	2 May 2000 22:02:36 -0000	1.10
+++ tests/thread.test	17 May 2004 20:58:31 -0000
@@ -19,10 +19,12 @@
 
 # Some tests require the testthread command
 
-set ::tcltest::testConstraints(testthread) \
-	[expr {[info commands testthread] != {}}]
+#set ::tcltest::testConstraints(testthread) \
+#	[expr {[info commands testthread] != {}}]
 
-if {$::tcltest::testConstraints(testthread)} {
+tcltest::constraints::cset testthread [expr {[info commands testthread] != {}}]
+
+if {[::tcltest::constraints::cset testthread]} {
 
     testthread errorproc ThreadError
 
Index: unix/tcl.m4
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tcl.m4,v
retrieving revision 1.114
diff -u -r1.114 tcl.m4
--- unix/tcl.m4	18 Mar 2004 19:01:43 -0000	1.114
+++ unix/tcl.m4	17 May 2004 20:58:48 -0000
@@ -469,6 +469,7 @@
 	ac_saved_libs=$LIBS
 	LIBS="$LIBS $THREADS_LIBS"
 	AC_CHECK_FUNCS(pthread_attr_setstacksize)
+	AC_CHECK_FUNCS(pthread_atfork)
 	LIBS=$ac_saved_libs
 	AC_CHECK_FUNCS(readdir_r)
     else
Index: unix/tclAppInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclAppInit.c,v
retrieving revision 1.11
diff -u -r1.11 tclAppInit.c
--- unix/tclAppInit.c	31 May 2002 22:20:22 -0000	1.11
+++ unix/tclAppInit.c	17 May 2004 20:58:48 -0000
@@ -15,6 +15,7 @@
  */
 
 #include "tcl.h"
+#include "tclPort.h"
 
 #ifdef TCL_TEST
 
Index: unix/tclUnixInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixInit.c,v
retrieving revision 1.41
diff -u -r1.41 tclUnixInit.c
--- unix/tclUnixInit.c	7 Apr 2004 22:04:30 -0000	1.41
+++ unix/tclUnixInit.c	17 May 2004 20:58:49 -0000
@@ -937,6 +937,15 @@
     return result;
 }
 
+#if defined(TCL_THREADS) && defined(HAVE_PTHREAD_ATFORK)
+static pthread_once_t	once = PTHREAD_ONCE_INIT;
+ 
+static void
+InitAtfork(void)
+{
+    pthread_atfork(TclpAtforkLock, TclpAtForkParent, TclpAtForkChild);
+}
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -967,12 +976,17 @@
 	    return (TCL_ERROR);
 	};
     }
-    
+
+#if defined(TCL_THREADS) && defined(HAVE_PTHREAD_ATFORK)
+    pthread_once(&once, InitAtfork);
+#endif
+
     pathPtr = TclGetLibraryPath();
     if (pathPtr == NULL) {
 	pathPtr = Tcl_NewObj();
     }
     Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+
     return Tcl_Eval(interp, initScript);
 }
 
Index: unix/tclUnixPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPort.h,v
retrieving revision 1.35
diff -u -r1.35 tclUnixPort.h
--- unix/tclUnixPort.h	6 Apr 2004 22:25:57 -0000	1.35
+++ unix/tclUnixPort.h	17 May 2004 20:58:50 -0000
@@ -574,6 +574,10 @@
  */
 #define NO_REALPATH
 #endif
+EXTERN void		TclpAtforkLock(void);
+EXTERN void		TclpAtforkUnlock(void);
+EXTERN void		TclpAtForkChild(void);
+EXTERN void		TclpAtForkParent(void);
 #else
 typedef int TclpMutex;
 #define	TclpMutexInit(a)
Index: unix/tclUnixTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixTest.c,v
retrieving revision 1.16
diff -u -r1.16 tclUnixTest.c
--- unix/tclUnixTest.c	6 Apr 2004 22:25:57 -0000	1.16
+++ unix/tclUnixTest.c	17 May 2004 20:58:50 -0000
@@ -81,6 +81,10 @@
 			    Tcl_Interp *interp, int argc, CONST char **argv));
 static int		TestgotsigCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv));
+static int		TestforkCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, CONST char **argv));
+static int		TestwaitpidCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 static void 		AlarmHandler _ANSI_ARGS_(());
 
 /*
@@ -120,6 +124,10 @@
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testfork", TestforkCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testwaitpid", TestwaitpidCmd,
+			 (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
 
@@ -702,3 +710,80 @@
     gotsig = "0";
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ * TestforkCmd --
+ *
+ * 	Implementation of fork().
+ *
+ * Results:
+ *	In the parent process, the child process' pid, in the child, 0.
+ *
+ * Side Effects:
+ *	Creates a new process.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestforkCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
+{
+    pid_t pid;
+
+    pid = fork();
+    if (pid < 0) {
+	Tcl_AppendResult(interp, "fork failed: ",
+			 Tcl_PosixError(interp),
+			 (char *)NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetIntObj (Tcl_GetObjResult (interp), (int)pid);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TestwaitpidCmd --
+ *
+ * 	Implementation of waitpid().
+ *
+ * Results:
+ *	Returns the PID of the process we waited on.
+ *
+ * Side Effects:
+ *	Waits untill the process in question exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwaitpidCmd(clientData, interp, objc, objv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];			/* Argument strings. */
+{
+    pid_t pid = 0;
+    pid_t returnPid = 0;
+    int status = 0;
+
+    if (Tcl_GetIntFromObj(interp, objv[1], &pid) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    returnPid = waitpid(pid, &status, 0);
+    if (returnPid < 0) {
+	Tcl_AppendResult(interp, "wait failed: ",
+			 Tcl_PosixError(interp),
+			 (char *)NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(returnPid));
+
+    return TCL_OK;
+}
Index: unix/tclUnixThrd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixThrd.c,v
retrieving revision 1.28
diff -u -r1.28 tclUnixThrd.c
--- unix/tclUnixThrd.c	23 Apr 2004 07:21:37 -0000	1.28
+++ unix/tclUnixThrd.c	17 May 2004 20:58:51 -0000
@@ -928,6 +928,35 @@
 
 #ifdef TCL_THREADS
 /*
+ * Additional functions to handle broken pthread behavior on fork().
+ * From the pthread_atfork man page:
+ *	To  understand  the purpose of pthread_atfork, recall that
+ *	fork(2)  duplicates  the  whole  memory  space,  including
+ *	mutexes in their current locking state, but only the call­
+ *	ing thread: other threads are not  running  in  the  child
+ *	process.   The  mutexes  are not usable after the fork and
+ *	must be initialized with pthread_mutex_init in  the  child
+ *	process.   This is a limitation of the current implementa­
+ *	tion and might or might not be present in future versions.
+ */
+#if 0
+/* this is called in parent before the fork() */
+void
+TclpAtforkLock(void)
+{
+    /* locks must be held in locking order (if any) */
+    Tcl_MutexLock((Tcl_Mutex *)&allocLockPtr);
+}
+
+/* this is called in both parent and child after the fork() */
+void
+TclpAtforkUnlock(void)
+{
+    /* locks must be released in same order as in atfork_lock() */
+    Tcl_MutexUnlock((Tcl_Mutex *)&allocLockPtr);
+}
+#endif
+/*
  * Additions by AOL for specialized thread memory allocator.
  */
 #ifdef USE_THREAD_ALLOC
