85068c2 · distributed-process

git.iko.soy/distributed-process

Part 2 to making forkProcess exception-safe.

The previous patch fixed exception safety inside the exception handlers of the spawned process. This time, we prevent exceptions from causing resources (such as processes) to leak if the caller `forkProcess` itself receives an exception (note that the caller is not always the node agent thread).

commit85068c20e9b4765aad6c276aac90194c60299152 authorMathieu Boespflug <m@tweag.io> dateSun 7 Dec 2014, 17:52 (12 years ago) parentfc0a1cc

2 files changed+11−2

compare with master

unifiedsplit

src/Control/Distributed/Process/Internal/StrictMVar.hs+8 src/Control/Distributed/Process/Node.hs+3−2

src/Control/Distributed/Process/Internal/StrictMVar.hs+8

@@ -10,6 +10,7 @@ module Control.Distributed.Process.Internal.StrictMVar

1010 , withMVar

1111 , modifyMVar_

1212 , modifyMVar

13+ , modifyMVarMasked

1314 , mkWeakMVar

1415 ) where

1516

@@ -26,6 +27,7 @@ import qualified Control.Concurrent.MVar as MVar

2627 , withMVar

2728 , modifyMVar_

2829 , modifyMVar

30+ , modifyMVarMasked

2931 )

3032import GHC.MVar (MVar(MVar))

3133import GHC.IO (IO(IO))

@@ -61,6 +63,12 @@ modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)

6163 evaluateFst :: (a, b) -> IO (a, b)

6264 evaluateFst (x, y) = evaluate x >> return (x, y)

6365

66+modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b

67+modifyMVarMasked (StrictMVar v) f = MVar.modifyMVarMasked v (f >=> evaluateFst)

68+ where

69+ evaluateFst :: (a, b) -> IO (a, b)

70+ evaluateFst (x, y) = evaluate x >> return (x, y)

71+

6472mkWeakMVar :: StrictMVar a -> IO () -> IO (Weak (StrictMVar a))

6573mkWeakMVar m@(StrictMVar (MVar m#)) f = IO $ \s ->

6674 case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)

src/Control/Distributed/Process/Node.hs+3−2

@@ -71,7 +71,7 @@ import Control.Concurrent (forkIO, forkIOWithUnmask, myThreadId)

7171import Control.Distributed.Process.Internal.StrictMVar

7272 ( newMVar

7373 , withMVar

74− , modifyMVar

74+ , modifyMVarMasked

7575 , modifyMVar_

7676 , newEmptyMVar

7777 , putMVar

@@ -332,7 +332,8 @@ runProcess node proc = do

332332

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

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

335−forkProcess node proc = modifyMVar (localState node) startProcess

335+forkProcess node proc =

336+ modifyMVarMasked (localState node) startProcess

336337 where

337338 startProcess :: LocalNodeState -> IO (LocalNodeState, ProcessId)

338339 startProcess st = do