@@ -23,7 +23,7 @@ module Control.AutoUpdate (
2323import Control.Concurrent (forkIO, threadDelay)
2424import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar,
2525 takeMVar, tryPutMVar, tryTakeMVar)
26−import Control.Exception (SomeException, catch, throw)
26+import Control.Exception (SomeException, catch, throw, mask_, try)
2727import Control.Monad (forever, void)
2828import Data.IORef (newIORef, readIORef, writeIORef)
2929
@@ -89,8 +89,33 @@ mkAutoUpdate us = do
8989 -- is Nothing.
9090 lastValue <- newEmptyMVar
9191
92− -- fork the worker thread immediately...
93− void $ forkIO $ forever $ do
92+ -- This is used to set a value in the currRef variable when the worker
93+ -- thread exits. In reality, that value should never be used, since the
94+ -- worker thread exiting only occurs if an async exception is thrown, which
95+ -- should only occur if there are no references to needsRunning left.
96+ -- However, this handler will make error messages much clearer if there's a
97+ -- bug in the implementation.
98+ let fillRefOnExit f = do
99+ eres <- try f
100+ case eres of
101+ Left e -> writeIORef currRef $ error $
102+ "Control.AutoUpdate.mkAutoUpdate: worker thread exited with exception: "
103+ ++ (show (e :: SomeException))
104+ Right () -> writeIORef currRef $ error $
105+ "Control.AutoUpdate.mkAutoUpdate: worker thread exited normally, "
106+ ++ "which should be impossible due to usage of forever"
107+
108+ -- fork the worker thread immediately. Note that we mask async exceptions,
109+ -- but *not* in an uninterruptible manner. This will allow a
110+ -- BlockedIndefinitelyOnMVar exception to still be thrown, which will take
111+ -- down this thread when all references to the returned function are
112+ -- garbage collected, and therefore there is no thread that can fill the
113+ -- needsRunning MVar.
114+ --
115+ -- Note that since we throw away the ThreadId of this new thread and never
116+ -- calls myThreadId, normal async exceptions can never be thrown to it,
117+ -- only RTS exceptions.
118+ mask_ $ void $ forkIO $ fillRefOnExit $ forever $ do
94119 -- but block until a value is actually needed
95120 takeMVar needsRunning
96121