deadc44 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Fix race in runProcess when it fails.

deadc44Facundo Domínguez11 years ago

src/Control/Distributed/Process/Node.hs+5−7

@@ -205,11 +205,10 @@ import Control.Distributed.Process.Internal.Messaging

205 )

206import Control.Distributed.Process.Internal.Primitives

207 ( register

208− , finally

209 , receiveWait

208 , receiveWait

210 , match

209 , match

211 , sendChan

210 , sendChan

212− , catch

211+ , try

213 , unwrapMessage

212 , unwrapMessage

214 )

213 )

215import Control.Distributed.Process.Internal.Types (SendPort, Tracer(..))

214import Control.Distributed.Process.Internal.Types (SendPort, Tracer(..))

@@ -355,11 +354,10 @@ closeLocalNode node = do

355runProcess :: LocalNode -> Process () -> IO ()

354runProcess :: LocalNode -> Process () -> IO ()

356runProcess node proc = do

355runProcess node proc = do

357 done <- newEmptyMVar

356 done <- newEmptyMVar

358− tid <- myThreadId

357+ -- TODO; When forkProcess inherits the masking state, protect the forked

358+ -- thread against async exceptions that could occur before 'try' is evaluated.

359− void $ forkProcess node $ do

359+ void $ forkProcess node $ try proc >>= liftIO . putMVar done

360− catch (proc `finally` liftIO (putMVar done ()))

360+ takeMVar done >>= either (throwIO :: SomeException -> IO a) return

361− (\(ex :: SomeException) -> liftIO $ throwTo tid ex)

362− takeMVar done

363

361

364-- | Spawn a new process on a local node

362-- | Spawn a new process on a local node

365forkProcess :: LocalNode -> Process () -> IO ProcessId

363forkProcess :: LocalNode -> Process () -> IO ProcessId