Have System.Timeout.timeout fail if exceptions are uninterruptibly masked
Motivation
The following contrieved program blocks indefinitely because UnliftIO.finally
masks exceptions uninterruptibly.
return () `UnliftIO.finally` timeout 100 (forever $ threadDelay maxBound)
Proposal
There is no way that timeout
can deliver its asynchronous exception if the exceptions are masked uninterruptibly. It is easier to discover the mistake of calling timeout
if it throws an error, rather than letting it block. Therefore, we should modify timeout as follows and document the new precondition.
timeout :: Int -> IO a -> IO (Maybe a)
timeout n f
| n < 0 = fmap Just f
| n == 0 = return Nothing
#if !defined(mingw32_HOST_OS)
| rtsSupportsBoundThreads = do
+ checkNonUninterruptibleMask
pid <- myThreadId
ex <- fmap Timeout newUnique
...
#endif
| otherwise = do
+ checkNonUninterruptibleMask
pid <- myThreadId
ex <- fmap Timeout newUnique
...
+ where
+ checkNonUninterruptibleMask = do
+ maskingState <- getMaskingState
+ when (maskingState == Unmasked) $
+ error "System.Timeout.timeout called with exceptions uninterruptibly masked"
Additionally, maybe we should add a HasCallStack
constraint so the offending timeout
call is easier to spot.