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	25 Mar 2004 11:29:20 -0000
@@ -258,6 +260,29 @@
     threadReap
     lrange $msg 0 2
 } {cannot join thread}
+
+test thread-6.0 {See if tcl and threads survive a fork()} {testthread unixOnly} {
+    set pid [testfork]
+    if {$pid == 0} {
+	exit 0
+    } else {
+	set retpid [testwaitpid $pid]
+    }
+    expr $pid == $retpid
+} {1}
+
+test thread-6.1 {See if tcl, threads, and an event survive a fork()} {testthread unixOnly} {
+    after 1000 [list set foo 1]
+    set pid [testfork]
+    if {$pid == 0} {
+	vwait foo
+	exit 0
+    } else {
+	testwaitpid $pid
+    }
+    vwait foo
+    set foo
+} {1}
 
 # cleanup
 ::tcltest::cleanupTests
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	25 Mar 2004 11:29:23 -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//tclUnixInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixInit.c,v
retrieving revision 1.39
diff -u -r1.39 tclUnixInit.c
--- unix//tclUnixInit.c	9 Mar 2004 13:34:45 -0000	1.39
+++ unix//tclUnixInit.c	25 Mar 2004 11:29:23 -0000
@@ -935,6 +935,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
 /*
  *----------------------------------------------------------------------
  *
@@ -965,12 +974,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.34
diff -u -r1.34 tclUnixPort.h
--- unix//tclUnixPort.h	9 Mar 2004 13:32:26 -0000	1.34
+++ unix//tclUnixPort.h	25 Mar 2004 11:29:24 -0000
@@ -578,6 +578,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.15
diff -u -r1.15 tclUnixTest.c
--- unix//tclUnixTest.c	13 Oct 2003 00:59:48 -0000	1.15
+++ unix//tclUnixTest.c	25 Mar 2004 11:29:24 -0000
@@ -82,6 +82,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_(());
 
 /*
@@ -121,6 +125,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;
 }
 
@@ -701,5 +709,82 @@
 {
     Tcl_AppendResult(interp, gotsig, (char *) NULL);
     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;
 }
