@@ -189,112 +189,113 @@ testAgentEventHandling result = do
189189 stash result $ seenAlive && seenDead
190190 kill agentPid "test-complete" >> awaitExit agentPid
191191
192−testMxRegEvents :: Process ()
193−testMxRegEvents = do
194−
192+testMxRegEvents :: TestResult () -> Process ()
193+testMxRegEvents result = do
195194 {- This test only deals with the local case, to ensure that we are being
196195 notified in the expected order - the remote cases related to the
197196 behaviour of the node controller are contained in the CH test suite. -}
197+ ensure (stash result ()) $ do
198+ let label = "testMxRegEvents"
199+ let agentLabel = "mxRegEvents-agent"
200+ let delay = 1000000
201+ (regChan, regSink) <- newChan
202+ (unRegChan, unRegSink) <- newChan
203+ agent <- mxAgent (MxAgentId agentLabel) () [
204+ mxSink $ \ev -> do
205+ case ev of
206+ MxRegistered pid label'
207+ | label' == label -> liftMX $ sendChan regChan (label', pid)
208+ MxUnRegistered pid label'
209+ | label' == label -> liftMX $ sendChan unRegChan (label', pid)
210+ _ -> return ()
211+ mxReady
212+ ]
198213
199− let label = "testMxRegEvents"
200− let agentLabel = "mxRegEvents-agent"
201− let delay = 1000000
202− (regChan, regSink) <- newChan
203− (unRegChan, unRegSink) <- newChan
204− agent <- mxAgent (MxAgentId agentLabel) () [
205− mxSink $ \ev -> do
206− case ev of
207− MxRegistered pid label
208− | label /= agentLabel -> liftMX $ sendChan regChan (label, pid)
209− MxUnRegistered pid label
210− | label /= agentLabel -> liftMX $ sendChan unRegChan (label, pid)
211− _ -> return ()
212− mxReady
213− ]
214+ p1 <- spawnLocal expect
215+ p2 <- spawnLocal expect
216+
217+ register label p1
218+ reg1 <- receiveChanTimeout delay regSink
219+ reg1 `shouldBe` equalTo (Just (label, p1))
220+
221+ unregister label
222+ unreg1 <- receiveChanTimeout delay unRegSink
223+ unreg1 `shouldBe` equalTo (Just (label, p1))
224+
225+ register label p2
226+ reg2 <- receiveChanTimeout delay regSink
227+ reg2 `shouldBe` equalTo (Just (label, p2))
228+
229+ reregister label p1
230+ unreg2 <- receiveChanTimeout delay unRegSink
231+ unreg2 `shouldBe` equalTo (Just (label, p2))
232+
233+ reg3 <- receiveChanTimeout delay regSink
234+ reg3 `shouldBe` equalTo (Just (label, p1))
235+
236+ mapM_ (flip kill $ "test-complete") [agent, p1, p2]
237+ awaitExit agent
238+
239+testMxRegMon :: LocalNode -> TestResult () -> Process ()
240+testMxRegMon remoteNode result = do
241+ ensure (stash result ()) $ do
242+ -- ensure that when a registered process dies, we get a notification that
243+ -- it has been unregistered as well as seeing the name get removed
244+ let label1 = "aaaaa"
245+ let label2 = "bbbbb"
246+ let isValid l = l == label1 || l == label2
247+ let agentLabel = "mxRegMon-agent"
248+ let delay = 1000000
249+ (regChan, regSink) <- newChan
250+ (unRegChan, unRegSink) <- newChan
251+ agent <- mxAgent (MxAgentId agentLabel) () [
252+ mxSink $ \ev -> do
253+ case ev of
254+ MxRegistered pid label
255+ | isValid label -> liftMX $ sendChan regChan (label, pid)
256+ MxUnRegistered pid label
257+ | isValid label -> liftMX $ sendChan unRegChan (label, pid)
258+ _ -> return ()
259+ mxReady
260+ ]
214261
215− p1 <- spawnLocal expect
216− p2 <- spawnLocal expect
217−
218− register label p1
219− reg1 <- receiveChanTimeout delay regSink
220− reg1 `shouldBe` equalTo (Just (label, p1))
221−
222− unregister label
223− unreg1 <- receiveChanTimeout delay unRegSink
224− unreg1 `shouldBe` equalTo (Just (label, p1))
225−
226− register label p2
227− reg2 <- receiveChanTimeout delay regSink
228− reg2 `shouldBe` equalTo (Just (label, p2))
229−
230− reregister label p1
231− unreg2 <- receiveChanTimeout delay unRegSink
232− unreg2 `shouldBe` equalTo (Just (label, p2))
233−
234− reg3 <- receiveChanTimeout delay regSink
235− reg3 `shouldBe` equalTo (Just (label, p1))
236−
237− mapM_ (flip kill $ "test-complete") [agent, p1, p2]
238− awaitExit agent
239−
240−testMxRegMon :: LocalNode -> Process ()
241−testMxRegMon remoteNode = do
242−
243− -- ensure that when a registered process dies, we get a notification that
244− -- it has been unregistered as well as seeing the name get removed
245−
246− let label1 = "aaaaa"
247− let label2 = "bbbbb"
248− let isValid l = l == label1 || l == label2
249− let agentLabel = "mxRegMon-agent"
250− let delay = 1000000
251− (regChan, regSink) <- newChan
252− (unRegChan, unRegSink) <- newChan
253− agent <- mxAgent (MxAgentId agentLabel) () [
254− mxSink $ \ev -> do
255− case ev of
256− MxRegistered pid label
257− | isValid label -> liftMX $ sendChan regChan (label, pid)
258− MxUnRegistered pid label
259− | isValid label -> liftMX $ sendChan unRegChan (label, pid)
260− _ -> return ()
261− mxReady
262− ]
262+ (sp, rp) <- newChan
263+ liftIO $ forkProcess remoteNode $ do
264+ getSelfPid >>= sendChan sp
265+ expect :: Process ()
263266
264− (sp, rp) <- newChan
265− liftIO $ forkProcess remoteNode $ do
266− getSelfPid >>= sendChan sp
267− expect :: Process ()
267+ p1 <- receiveChan rp
268268
269− p1 <- receiveChan rp
269+ register label1 p1
270+ reg1 <- receiveChanTimeout delay regSink
271+ reg1 `shouldBe` equalTo (Just (label1, p1))
270272
271− register label1 p1
272− reg1 <- receiveChanTimeout delay regSink
273− reg1 `shouldBe` equalTo (Just (label1, p1))
273+ register label2 p1
274+ reg2 <- receiveChanTimeout delay regSink
275+ reg2 `shouldBe` equalTo (Just (label2, p1))
274276
275− register label2 p1
276− reg2 <- receiveChanTimeout delay regSink
277− reg2 `shouldBe` equalTo (Just (label2, p1))
277+ n1 <- whereis label1
278+ n1 `shouldBe` equalTo (Just p1)
278279
279− n1 <- whereis label1
280− n1 `shouldBe` equalTo (Just p1)
280+ n2 <- whereis label2
281+ n2 `shouldBe` equalTo (Just p1)
281282
282− n2 <- whereis label2
283− n2 `shouldBe` equalTo (Just p1)
283+ kill p1 "goodbye"
284284
285− kill p1 "goodbye"
285+ unreg1 <- receiveChanTimeout delay unRegSink
286+ unreg2 <- receiveChanTimeout delay unRegSink
286287
287− unreg1 <- receiveChanTimeout delay unRegSink
288− unreg2 <- receiveChanTimeout delay unRegSink
288+ let evts = [unreg1, unreg2]
289+ -- we can't rely on the order of the values in the node controller's
290+ -- map (it's either racy to do so, or no such guarantee exists for Data.Map),
291+ -- so we simply verify that we received the un-registration events we expect
292+ evts `shouldContain` (Just (label1, p1))
293+ evts `shouldContain` (Just (label2, p1))
289294
290− let evts = [unreg1, unreg2]
291− -- we can't rely on the order of the values in the node controller's
292− -- map (it's either racy to do so, or no such guarantee exists for Data.Map),
293− -- so we simply verify that we received the un-registration events we expect
294− evts `shouldContain` (Just (label1, p1))
295− evts `shouldContain` (Just (label2, p1))
295+ kill agent "test-complete" >> awaitExit agent
296296
297− kill agent "test-complete" >> awaitExit agent
297+ensure :: Process () -> Process () -> Process ()
298+ensure = flip finally
298299
299300tests :: TestTransport -> IO [Test]
300301tests TestTransport{..} = do
@@ -327,8 +328,12 @@ tests TestTransport{..} = do
327328 ]
328329 , testGroup "Mx Events" [
329330 testCase "Name Registration Events"
330− (runProcess node1 testMxRegEvents)
331+ (delayedAssertion
332+ "expected registration events to map to the correct ProcessId"
333+ node1 () testMxRegEvents)
331334 , testCase "Post Death Name UnRegistration Events"
332− (runProcess node1 (testMxRegMon node2))
335+ (delayedAssertion
336+ "expected process deaths to result in unregistration events"
337+ node1 () (testMxRegMon node2))
333338 ]
334339 ]