Have System.Timeout.timeout fail if exceptions are uninterruptibly masked
The following contrieved program blocks indefinitely because
UnliftIO.finally masks exceptions uninterruptibly.
return () `UnliftIO.finally` timeout 100 (forever $ threadDelay maxBound)
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.