GitLab

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.