Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,11 @@ +2013-07-17 Harald Oehlmann + + * tclUnixNotify.c Tcl_InitNotifier: RFE [a0bc856dcd] + Start notifier thread again if we were forked, to solve Rivet bug + 55153. + 2013-07-05 Kevin B. Kenny * library/tzdata/Africa/Casablanca: * library/tzdata/America/Asuncion: * library/tzdata/Antarctica/Macquarie: ADDED tests/unixForkEvent.test Index: tests/unixForkEvent.test ================================================================== --- /dev/null +++ tests/unixForkEvent.test @@ -0,0 +1,45 @@ +# This file contains a collection of tests for the procedures in the file +# tclUnixNotify.c. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require tcltest 2 +namespace import -force ::tcltest::* + +testConstraint testfork [llength [info commands testfork]] + +# Test if the notifier thread is well initialized in a forked interpreter +# by Tcl_InitNotifier +test unixforkevent-1.1 {fork and test writeable event} \ + -constraints testfork \ + -body { + set folder [makeDirectory unixtestfork] + set pid [testfork] + if {$pid == 0} { + # we are the forked process + set result initialized + set h [open [file join $folder test.txt] w] + fileevent $h writable\ + "set result writable;\ + after cancel [after 1000 {set result timeout}]" + vwait result + close $h + makeFile $result result.txt $folder + exit + } + # we are the original process + while {![file readable [file join $folder result.txt]]} {} + viewFile result.txt $folder + } \ + -result {writable} \ + -cleanup { + catch { removeFolder $folder } + } + +::tcltest::cleanupTests +return Index: unix/tclUnixNotfy.c ================================================================== --- unix/tclUnixNotfy.c +++ unix/tclUnixNotfy.c @@ -110,11 +110,11 @@ * this condition variable. */ #endif /* __CYGWIN__ */ 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; #ifdef TCL_THREADS @@ -125,10 +125,19 @@ * You must hold the notifierMutex lock before accessing this variable. */ 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. * @@ -183,11 +192,11 @@ * This is the thread ID of the notifier thread that does select. */ static Tcl_ThreadId notifierThread; -#endif +#endif /* TCL_THREADS */ /* * Static routines defined in this file. */ @@ -265,15 +274,27 @@ /* * Start the Notifier thread if necessary. */ Tcl_MutexLock(¬ifierMutex); + /* + * 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(¬ifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread"); } + processIDInitialized = getpid(); } notifierCount++; /* * Wait for the notifier pipe to be created. @@ -282,11 +303,11 @@ while (triggerPipe < 0) { Tcl_ConditionWait(¬ifierCV, ¬ifierMutex, NULL); } Tcl_MutexUnlock(¬ifierMutex); -#endif +#endif /* TCL_THREADS */ return (ClientData) tsdPtr; } /* *---------------------------------------------------------------------- Index: unix/tclUnixTest.c ================================================================== --- unix/tclUnixTest.c +++ unix/tclUnixTest.c @@ -64,10 +64,12 @@ Tcl_Interp *interp, int argc, CONST char **argv); 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, Tcl_Interp *interp, int argc, CONST char **argv); static int TestsetdefencdirCmd(ClientData dummy, @@ -107,10 +109,12 @@ Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, (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, (ClientData) 0, NULL); @@ -531,10 +535,53 @@ } 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; +} /* *---------------------------------------------------------------------- * * TestgetdefencdirCmd --