Rebase to core-8-5-branch

Add "testfork" test command to be usable in testcase.

2 files changed, 71 insertions, 3 deletions

diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 51f0b1f..88e290e 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -112,7 +112,7 @@ typedef struct ThreadSpecificData {
     int eventReady;		/* True if an event is ready to be processed.
 				 * Used as condition flag together with waitCV
 				 * above. */
-#endif
+#endif /* TCL_THREADS */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
@@ -128,6 +128,15 @@ static Tcl_ThreadDataKey dataKey;
 static int notifierCount = 0;
 
 /*
+ * The following static stores the process ID of the initialized notifier
+ * thread. If it changes, we have passed a fork and we should start a new
+ * notifier thread.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+static pid_t processIDInitialized = 0;
+
+/*
  * The following variable points to the head of a doubly-linked list of
  * ThreadSpecificData structures for all threads that are currently waiting on
  * an event.
@@ -185,7 +194,7 @@ static Tcl_Condition notifierCV;
 
 static Tcl_ThreadId notifierThread;
 
-#endif
+#endif /* TCL_THREADS */
 
 /*
  * Static routines defined in this file.
@@ -267,10 +276,22 @@ Tcl_InitNotifier(void)
      */
 
     Tcl_MutexLock(&notifierMutex);
+    /*
+     * Check if my process id changed, e.g. I was forked
+     * In this case, restart the notifier thread and close the
+     * pipe to the original notifier thread
+     */
+    if (notifierCount > 0 && processIDInitialized != getpid()) {
+	notifierCount = 0;
+	processIDInitialized = 0;
+	close(triggerPipe);
+	triggerPipe = -1;
+    }
     if (notifierCount == 0) {
 	if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
 		TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
 	    Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
+	    processIDInitialized = getpid();
 	}
     }
     notifierCount++;
@@ -284,7 +305,7 @@ Tcl_InitNotifier(void)
     }
 
     Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
     return (ClientData) tsdPtr;
 }
 
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index b6529c2..39cddef 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -66,6 +66,8 @@ static int		TestfilewaitCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestfindexecutableCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
+static int		TestforkObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST *argv);
 static int		TestgetopenfileCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestgetdefencdirCmd(ClientData dummy,
@@ -110,6 +112,8 @@ TclplatformtestInit(
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
             (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
+            (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
@@ -533,6 +537,49 @@ TestsetdefencdirCmd(
     Tcl_SetDefaultEncodingDir(argv[1]);
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestforkObjCmd --
+ *
+ *	This function implements the "testfork" command. It is used to
+ *	fork the Tcl process for specific test cases.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestforkObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST *objv)		/* Argument strings. */
+{
+    pid_t pid;
+
+    if (objc != 1) {
+        Tcl_WrongNumArgs(interp, 1, objv, "");
+        return TCL_ERROR;
+    }
+    pid = fork();
+    if (pid == -1) {
+        Tcl_AppendResult(interp,
+                "Cannot fork", NULL);
+        return TCL_ERROR;
+    }
+    if (pid==0) {
+	Tcl_InitNotifier();
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------