git.iko.soy/distributed-process
on master help sign in
avoid an inter-test dependency by ensuring all agents are dead and unregistered
commitdf86d5af2d532422f88ed113f980422f41115b68 authorTim Watson <watson.timothy@gmail.com> dateMon 12 Nov 2018, 21:51 (8 years ago) parent1984883
1 file changed+21−7
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+21−7
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+21−7
@@ -45,6 +45,16 @@ data Publish = Publish
4545
4646instance Binary Publish where
4747
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+
4858testAgentBroadcast :: TestResult () -> Process ()
4959testAgentBroadcast result = do
5060 (resultSP, resultRP) <- newChan :: Process (SendPort (), ReceivePort ())
@@ -62,13 +72,13 @@ testAgentBroadcast result = do
6272 -- and the consumer will see that and send the result to our typed channel.
6373 stash result =<< receiveChan resultRP
6474
65− kill publisher "finished"
66− kill consumer "finished"
75+ kill publisher "finished" >> awaitExit publisher
76+ kill consumer "finished" >> awaitExit consumer
6777
6878testAgentDualInput :: TestResult (Maybe Int) -> Process ()
6979testAgentDualInput result = do
7080 (sp, rp) <- newChan
71− _ <- mxAgent (MxAgentId "sum-agent") (0 :: Int) [
81+ s <- mxAgent (MxAgentId "sum-agent") (0 :: Int) [
7282 mxSink $ (\(i :: Int) -> do
7383 mxSetLocal . (+i) =<< mxGetLocal
7484 i' <- mxGetLocal
@@ -85,6 +95,7 @@ testAgentDualInput result = do
8595 mxNotify (5 :: Int)
8696
8797 stash result =<< receiveChanTimeout 10000000 rp
98+ awaitExit s
8899
89100testAgentPrioritisation :: TestResult [String] -> Process ()
90101testAgentPrioritisation result = do
@@ -96,8 +107,8 @@ testAgentPrioritisation result = do
96107
97108 let name = "prioritising-agent"
98109 (sp, rp) <- newChan
99− void $ mxAgent (MxAgentId name) ["first"] [
100− mxSink (\(s :: String) -> do
110+ s <- mxAgent (MxAgentId name) ["first"] [
111+ mxSink (\(s :: String) -> do
101112 mxUpdateLocal ((s:))
102113 st <- mxGetLocal
103114 case length st of
@@ -113,6 +124,7 @@ testAgentPrioritisation result = do
113124 nsend name "fifth"
114125
115126 stash result . sort =<< receiveChan rp
127+ awaitExit s
116128
117129testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()
118130testAgentMailboxHandling result = do
@@ -124,7 +136,7 @@ testAgentMailboxHandling result = do
124136 nsend "mailbox-agent" ()
125137
126138 stash result =<< receiveChanTimeout 1000000 rp
127− kill agent "finished"
139+ kill agent "finished" >> awaitExit agent
128140
129141testAgentEventHandling :: TestResult Bool -> Process ()
130142testAgentEventHandling result = do
@@ -175,6 +187,7 @@ testAgentEventHandling result = do
175187 seenDead <- receiveChan reply
176188
177189 stash result $ seenAlive && seenDead
190+ kill agentPid "test-complete" >> awaitExit agentPid
178191
179192testMxRegEvents :: Process ()
180193testMxRegEvents = do
@@ -222,6 +235,7 @@ testMxRegEvents = do
222235 reg3 `shouldBe` equalTo (Just (label, p1))
223236
224237 mapM_ (flip kill $ "test-complete") [agent, p1, p2]
238+ awaitExit agent
225239
226240testMxRegMon :: LocalNode -> Process ()
227241testMxRegMon remoteNode = do
@@ -280,7 +294,7 @@ testMxRegMon remoteNode = do
280294 evts `shouldContain` (Just (label1, p1))
281295 evts `shouldContain` (Just (label2, p1))
282296
283− kill agent "test-complete"
297+ kill agent "test-complete" >> awaitExit agent
284298
285299tests :: TestTransport -> IO [Test]
286300tests TestTransport{..} = do