Permalink
Browse files

Fix deadlocks induced by withoutMVar (fixes evan-hang)

  • Loading branch information...
1 parent 13f1afd commit 477c4caadb37e4be47f132c5ae1184923a1d0ae4 @batterseapower committed Sep 11, 2011
Showing with 12 additions and 2 deletions.
  1. +12 −2 Development/Shake/Core.hs
View
@@ -438,8 +438,18 @@ need fps = do
appendHistory $ Need (fps `zip` need_times)
return need_times
-withoutMVar :: MonadIO m => MVar a -> a -> m b -> m (a, b)
-withoutMVar mvar x act = liftIO (putMVar mvar x) >> act >>= \y -> liftIO (takeMVar mvar) >>= \x' -> return (x', y)
+withoutMVar :: MonadPeelIO m => MVar a -> a -> m b -> m (a, b)
+withoutMVar mvar x act = do
+ liftIO (putMVar mvar x)
+ -- Suprisingly, it is important that we take from the MVar if there is an exception from act.
+ -- The reason is that we might have something like this:
+ -- modfiyMVar mvar $ \x -> withoutMVar mvar x $ throwIO e
+ --
+ -- If we don't take from the MVar when we get the exception, modifyMVar will block because
+ -- its onException handler tries to put into the (full) MVar.
+ y <- act `Exception.onException` liftIO (takeMVar mvar)
+ x' <- liftIO (takeMVar mvar)
+ return (x', y)
-- We assume that the rules do not change to include new dependencies often: this lets
-- us not rerun a rule as long as it looks like the dependencies of the *last known run*

0 comments on commit 477c4ca

Please sign in to comment.