ff07b9f · distributed-process

git.iko.soy/distributed-process

on master help sign in

Protect callLocal from asynchronous exceptions during the clean up.

ff07b9fFacundo Domínguez11 years ago

src/Control/Distributed/Process.hs+13−4

compare with master

unifiedsplit

@@ -199,6 +199,7 @@ import Control.Distributed.Process.Internal.Types

199 , WhereIsReply(..)

200 , RegisterReply(..)

201 , LocalProcess(processNode)

202+ , runLocalProcess

202 , Message

203 , Message

203 )

204 )

204import Control.Distributed.Process.Serializable (Serializable)

205import Control.Distributed.Process.Serializable (Serializable)

@@ -316,7 +317,7 @@ import Control.Distributed.Process.Internal.Spawn

316 , spawnSupervised

317 , spawnSupervised

317 , call

318 , call

318 )

319 )

319−import Control.Exception (SomeException, throw)

320+import Control.Exception (SomeException, throw, uninterruptibleMask_)

320

321

321-- INTERNAL NOTES

322-- INTERNAL NOTES

322--

323--

@@ -421,7 +422,15 @@ callLocal proc = mask $ \release -> do

421 try (sendChan spInit () >> release proc) >>= liftIO . putMVar mv

422 try (sendChan spInit () >> release proc) >>= liftIO . putMVar mv

422 rs <- liftIO (takeMVar mv)

423 rs <- liftIO (takeMVar mv)

423 `onException`

424 `onException`

425+ -- Exceptions need to be prevented from interrupting the clean up or

426+ -- the original exception which caused entering the handler could be

427+ -- forgotten. For instance, this could have a problematic effect

428+ -- when the original exception was meant to kill the thread and the

429+ -- second exception doesn't (like the exception thrown by

430+ -- 'System.Timeout.timeout').

431+ do lproc <- ask

432+ liftIO $ uninterruptibleMask_ $ runLocalProcess lproc $ do

424− do receiveChan rpInit

433+ receiveChan rpInit

425− kill child "exception in parent process"

434+ kill child "exception in parent process"

426− liftIO (takeMVar mv)

435+ liftIO (takeMVar mv)

427 either throw return rs

436 either throw return rs