Race-condition in alternative 'System.Timeout.timeout' implementation
bertram.felgenhauer at googlemail.com
Thu Feb 28 00:44:26 CET 2013
Akio Takano wrote:
> Thank you for the explanation. My previous attempt obviously suffers
> from the race condition you mention.
> However it still seems to be possible to implement a compromise, using
> both the IO manager and a new thread, i.e. forking only when the
> computation is being timed out. The following implementation is as
> fast as Herbert's timeout2, at least in the benchmark where the
> computation rarely times out.
Brilliant! I believe this version will work; the Timeout exception
cannot escape the timeout call anymore by the same reasoning as in
System.Timeout.timeout (with the bugfix for 7719 which consists
solely of adding uninterruptibleMask_ around killThread); the main
difference is that the creation of the killing thread is delayed
until it is actually needed.
(I also love the dual purpose 'killingThreadVar' MVar.)
Maybe it's time to reopen #4963?
> -- | Alternative implementation of 'System.Timeout.timeout' using
> -- 'GHC.Event.registerTimeout' AND a watchdog-thread.
> timeout4 :: Int -> IO a -> IO (Maybe a)
> timeout4 to f
> | to < 0 = fmap Just f
> | to == 0 = return Nothing
> | otherwise = do
> mainTid <- myThreadId
> ex <- fmap Timeout2 newUnique
> Just em <- E.getSystemEventManager -- FIXME
> killingThreadVar <- newEmptyMVar
> let timeoutHandler = (>>return ()) $ forkIO $ do
> killingTid <- myThreadId
> success <- tryPutMVar killingThreadVar killingTid
> when success $ throwTo mainTid ex
> cleanupTimeout key = uninterruptibleMask_ $ do
> -- Once the thread is in this uninterruptible block,
> -- it never receives the exception 'ex' because:
> -- (1) when we are in the uninterruptible block,
> -- all attept of throwTo to kill this thread
> -- will block.
> -- (2) the killing thread will either fail to fill
> -- 'killingThreadVar' or get killed before
> -- this thread exits the block.
> success <- tryPutMVar killingThreadVar undefined
> when (not success) $ do
> killingTid <- takeMVar killingThreadVar -- never blocks
> killThread killingTid
> E.unregisterTimeout em key
The unregisterTimeout has no effect if success is not set, so
why not use if-then-else?
> handleJust (\e -> if e == ex then Just () else Nothing)
> (\_ -> return Nothing)
> (bracket (E.registerTimeout em to timeoutHandler)
> (\_ -> fmap Just f))
More information about the Glasgow-haskell-users