modifyMVar does not restore value if callback returns error value

modifyMVar is currently implemented as follows:

modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
modifyMVar m io =
  mask $ \restore -> do
    a      <- takeMVar m
    (a',b) <- restore (io a) `onException` putMVar m a
    putMVar m a'
    return b

The problem is that it forces the (a',b) outside of the exception handler. If forcing this throws an exception, putMVar will not be called, and a subsequent withMVar or similar will hang. Example:

> import Control.Concurrent.MVar
> mv <- newMVar 'x'
> modifyMVar mv $ \_ -> return undefined
*** Exception: Prelude.undefined
> withMVar mv print
-- hang --

Perhaps we can fix it like this:

-     (a',b) <- restore (io a) `onException` putMVar m a
+     (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a

Trac metadata

Trac field	Value
Version	7.7
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	libraries/base
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture