git.iko.soy/distributed-process
on master help sign in
avoid an inter-test dependency by ensuring all agents are dead and unregistered
df86d5aTim Watson
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+21−7
compare with master
unifiedsplit
@@ -45,6 +45,16 @@ data Publish = Publish
45
45
46instance Binary Publish where
46instance Binary Publish where
47
47
48+awaitExit :: ProcessId -> Process ()
49+awaitExit pid =
50+ withMonitorRef pid $ \ref -> do
51+ receiveWait
52+ [ matchIf (\(ProcessMonitorNotification r _ _) -> r == ref)
53+ (\_ -> return ())
54+ ]
55+ where
56+ withMonitorRef pid = bracket (monitor pid) unmonitor
57+
48testAgentBroadcast :: TestResult () -> Process ()
58testAgentBroadcast :: TestResult () -> Process ()
49testAgentBroadcast result = do
59testAgentBroadcast result = do
50 (resultSP, resultRP) <- newChan :: Process (SendPort (), ReceivePort ())
60 (resultSP, resultRP) <- newChan :: Process (SendPort (), ReceivePort ())
@@ -62,13 +72,13 @@ testAgentBroadcast result = do
62 -- and the consumer will see that and send the result to our typed channel.
72 -- and the consumer will see that and send the result to our typed channel.
63 stash result =<< receiveChan resultRP
73 stash result =<< receiveChan resultRP
64
74
65− kill publisher "finished"
75+ kill publisher "finished" >> awaitExit publisher
66− kill consumer "finished"
76+ kill consumer "finished" >> awaitExit consumer
67
77
68testAgentDualInput :: TestResult (Maybe Int) -> Process ()
78testAgentDualInput :: TestResult (Maybe Int) -> Process ()
69testAgentDualInput result = do
79testAgentDualInput result = do
70 (sp, rp) <- newChan
80 (sp, rp) <- newChan
71− _ <- mxAgent (MxAgentId "sum-agent") (0 :: Int) [
81+ s <- mxAgent (MxAgentId "sum-agent") (0 :: Int) [
72 mxSink $ (\(i :: Int) -> do
82 mxSink $ (\(i :: Int) -> do
73 mxSetLocal . (+i) =<< mxGetLocal
83 mxSetLocal . (+i) =<< mxGetLocal
74 i' <- mxGetLocal
84 i' <- mxGetLocal
@@ -85,6 +95,7 @@ testAgentDualInput result = do
85 mxNotify (5 :: Int)
95 mxNotify (5 :: Int)
86
96
87 stash result =<< receiveChanTimeout 10000000 rp
97 stash result =<< receiveChanTimeout 10000000 rp
98+ awaitExit s
88
99
89testAgentPrioritisation :: TestResult [String] -> Process ()
100testAgentPrioritisation :: TestResult [String] -> Process ()
90testAgentPrioritisation result = do
101testAgentPrioritisation result = do
@@ -96,8 +107,8 @@ testAgentPrioritisation result = do
96
107
97 let name = "prioritising-agent"
108 let name = "prioritising-agent"
98 (sp, rp) <- newChan
109 (sp, rp) <- newChan
99− void $ mxAgent (MxAgentId name) ["first"] [
110+ s <- mxAgent (MxAgentId name) ["first"] [
100− mxSink (\(s :: String) -> do
111+ mxSink (\(s :: String) -> do
101 mxUpdateLocal ((s:))
112 mxUpdateLocal ((s:))
102 st <- mxGetLocal
113 st <- mxGetLocal
103 case length st of
114 case length st of
@@ -113,6 +124,7 @@ testAgentPrioritisation result = do
113 nsend name "fifth"
124 nsend name "fifth"
114
125
115 stash result . sort =<< receiveChan rp
126 stash result . sort =<< receiveChan rp
127+ awaitExit s
116
128
117testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()
129testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()
118testAgentMailboxHandling result = do
130testAgentMailboxHandling result = do
@@ -124,7 +136,7 @@ testAgentMailboxHandling result = do
124 nsend "mailbox-agent" ()
136 nsend "mailbox-agent" ()
125
137
126 stash result =<< receiveChanTimeout 1000000 rp
138 stash result =<< receiveChanTimeout 1000000 rp
127− kill agent "finished"
139+ kill agent "finished" >> awaitExit agent
128
140
129testAgentEventHandling :: TestResult Bool -> Process ()
141testAgentEventHandling :: TestResult Bool -> Process ()
130testAgentEventHandling result = do
142testAgentEventHandling result = do
@@ -175,6 +187,7 @@ testAgentEventHandling result = do
175 seenDead <- receiveChan reply
187 seenDead <- receiveChan reply
176
188
177 stash result $ seenAlive && seenDead
189 stash result $ seenAlive && seenDead
190+ kill agentPid "test-complete" >> awaitExit agentPid
178
191
179testMxRegEvents :: Process ()
192testMxRegEvents :: Process ()
180testMxRegEvents = do
193testMxRegEvents = do
@@ -222,6 +235,7 @@ testMxRegEvents = do
222 reg3 `shouldBe` equalTo (Just (label, p1))
235 reg3 `shouldBe` equalTo (Just (label, p1))
223
236
224 mapM_ (flip kill $ "test-complete") [agent, p1, p2]
237 mapM_ (flip kill $ "test-complete") [agent, p1, p2]
238+ awaitExit agent
225
239
226testMxRegMon :: LocalNode -> Process ()
240testMxRegMon :: LocalNode -> Process ()
227testMxRegMon remoteNode = do
241testMxRegMon remoteNode = do
@@ -280,7 +294,7 @@ testMxRegMon remoteNode = do
280 evts `shouldContain` (Just (label1, p1))
294 evts `shouldContain` (Just (label1, p1))
281 evts `shouldContain` (Just (label2, p1))
295 evts `shouldContain` (Just (label2, p1))
282
296
283− kill agent "test-complete"
297+ kill agent "test-complete" >> awaitExit agent
284
298
285tests :: TestTransport -> IO [Test]
299tests :: TestTransport -> IO [Test]
286tests TestTransport{..} = do
300tests TestTransport{..} = do