maoe / lifted-async

Run lifted IO operations asynchronously and wait for their results
http://hackage.haskell.org/package/lifted-async
BSD 3-Clause "New" or "Revised" License
29 stars 13 forks source link

withAsync shouldn't mask async exceptions in the first argument #1

Closed maoe closed 10 years ago

maoe commented 10 years ago

The following snippet fails to finish.

-- Courtesy of @liyang
{-# LANGUAGE ForeignFunctionInterface #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async.Lifted -- works without Lifted
import Control.Exception.Lifted
import Control.Monad.Reader
import Foreign.C.Types
import System.IO

foreign import ccall safe "sleep" c_sleep :: CInt -> IO CInt

delay :: Int -> IO ()
delay = threadDelay . (*) 1000

main :: IO ()
main = do
  a <- async $ do
    -- withAsync cancels zombie after the inner "delay 5000"
    withAsync zombie (\ _ -> delay 5000) `finally` do
      putStrLn "finally"
      delay 1000
  delay 100

  putStrLn "cancelling"
  cancel a -- throwTo the inner "delay 15000" a ThreadKilled;
  -- withAsync then @throwTo zombie ThreadKilled@, which is
  -- synchronous and does not return until it is delivered.
  putStrLn "cancelled"
  print =<< waitCatch a
  threadDelay 1000

zombie :: IO ()
zombie = forever $ do
  c_sleep 2 -- exception not deliverable here
  ms <- getMaskingState
  putStrLn $ "not dead " ++ show ms -- not here either, apparently
  -- allowInterrupt -- can be delivered, even in
maoe commented 10 years ago

Fixed in f6b99dd.