In response to question by Cat Dancer <cat@catdancer.ws> I wrote a few tests of sending asynchronous signal to a thread using GHC 6.6 The goal was to run a child thread via forkIO and use handle or finally to respond to the thread's demise. Unfortunately, it seems that there is an irreducible window where this fails. The forkIO returns but any exception handlers such as block/handle/catch/finally are not in place yet. So this fails:
module Main where
import Control.Exception import Control.Concurrent import Control.Concurrent.STM
forever x = x >> forever x
count tv = do val <- takeTMVar tv putTMVar tv $! (succ val) return val
-- Capture idiom of notifying a new MVar when a thread is finished fork todo = do doneMVar <- newEmptyMVar tid <- block $ forkIO $ block $ handle (\e -> print ("Exception",e) >> throw e) (finally (unblock todo) (print "dying!" >> putMVar doneMVar ())) return (doneMVar,tid)
spawn = do tv <- atomically (newTMVar 0) fork . forever $ atomically (count tv) >>= print
kill (mv,tid) = do -- yield print "killing.." killThread tid print "..checking corpse.." readMVar mv print "..confirmed dead"
main = spawn >>= kill
On my system, the above sends the killThread and destroys the thread before the handle or finally are setup, so the child thread never prints anything and never runs the "putMVar doneMVar ()". If I uncomment the yield statement then the child thread does start executing and the handle and finally work as desired. This makes it impossible to reliably do anything with the child thread. I cannot discern between a living and dead child thread at all, as there is way to know if it is waiting to be scheduled or if it has been killed waiting to be scheduled. The get/setUncaughtExceptionHandler does not seem to be inherited by the child thread, so this was not a useful guard. The best thing I can come up with is the ugly code:
fork todo = block $ do doneVar <- atomically (newEmptyTMVar) let putStarted = atomically (putTMVar doneVar False) putStopped = atomically (tryTakeTMVar doneVar >> putTMVar doneVar True) tid <- forkIO $ block $ (finally (putStarted >> unblock todo) putStopped) yield atomically $ do value <- takeTMVar doneVar when value (putTMVar doneVar True) return (doneVar,tid)
This does not return the ThreadId until the finally clause has started running. But if the thread is killed by any external force before getting that far then the main thread will hang on the "takeTMVar doneVar". Is there any remotely better way of forking a child with an exception handler? -- Chris