9de6c07..master · distributed-process

git.iko.soy/distributed-process

on master help sign in

distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+33−25

since splitsnapshots

unifiedsplit

@@ -46,11 +46,11 @@ import Control.Distributed.Process.Debug

46import Control.Distributed.Process.Management.Internal.Types

47import Control.Distributed.Process.Tests.Internal.Utils (shouldBe, pause)

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

49−import Data.Maybe (isNothing)

49+import Data.Maybe (isNothing, isJust)

50import Test.HUnit (Assertion, assertBool, assertFailure)

51import Test.Framework (Test, testGroup)

52import Test.Framework.Providers.HUnit (testCase)

53−import Control.Rematch hiding (match, isNothing)

53+import Control.Rematch hiding (match, isNothing, isJust)

54import Control.Rematch.Run (Match(..))

56newtype Ping = Ping ProcessId

@@ -735,7 +735,6 @@ testRemoteRegistry :: TestTransport -> Assertion

735testRemoteRegistry TestTransport{..} = do

736 node1 <- newLocalNode testTransport initRemoteTable

737 node2 <- newLocalNode testTransport initRemoteTable

738− done <- newEmptyMVar

739

738

740 pingServer <- forkProcess node1 ping

739 pingServer <- forkProcess node1 ping

741 deadProcess <- forkProcess node1 (return ())

740 deadProcess <- forkProcess node1 (return ())

@@ -750,6 +749,7 @@ testRemoteRegistry TestTransport{..} = do

750

749

751 pid <- verifyWhereIsRemote nid1 "ping"

750 pid <- verifyWhereIsRemote nid1 "ping"

752 liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid

751 liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid

752+

753 us <- getSelfPid

754 nsendRemote nid1 "ping" (Pong us)

755 receiveWait [

@@ -759,22 +759,22 @@ testRemoteRegistry TestTransport{..} = do

759 -- test that if process was not registered Nothing is returned

760 -- in owner field.

761 registerRemoteAsync nid1 "dead" deadProcess

762− receiveWait [

763− matchIf (\(RegisterReply label' False Nothing) -> "dead" == label')

762+ receiveWait [ matchIf (\(RegisterReply label' f mPid) -> "dead" == label')

764− (\(RegisterReply _ _ _) -> return ()) ]

763+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))

764+ ] >>= liftIO . assertBool "Expected False Nothing in RegisterReply"

765+

765 registerRemoteAsync nid1 "ping" deadProcess

766 registerRemoteAsync nid1 "ping" deadProcess

766 receiveWait [

767 receiveWait [

767− matchIf (\(RegisterReply label' False (Just pid'')) ->

768+ matchIf (\(RegisterReply label' False mPid) ->

768− "ping" == label' && pid'' == pingServer)

769+ "ping" == label' && isJust mPid)

769− (\(RegisterReply _ _ _) -> return ()) ]

770+ (\(RegisterReply _ f (Just pid'')) -> return (not f && pid'' == pingServer))

771+ ] >>= liftIO . assertBool "Expected False and (Just alreadyRegisteredPid) in RegisterReply"

772+

770 unregisterRemoteAsync nid1 "dead"

773 unregisterRemoteAsync nid1 "dead"

771 receiveWait [

774 receiveWait [

772− matchIf (\(RegisterReply label' False Nothing) ->

775+ matchIf (\(RegisterReply label' _ _) -> "dead" == label')

773− "dead" == label' && pid == pingServer)

776+ (\(RegisterReply _ f mPid) -> return (not f && isNothing mPid))

774− (\(RegisterReply _ _ _) -> return ()) ]

777+ ] >>= liftIO . assertBool "Expected False and Nothing in RegisterReply"

775− liftIO $ putMVar done ()

776−

777− takeMVar done

778

779testRemoteRegistryRemoteProcess :: TestTransport -> Assertion

780testRemoteRegistryRemoteProcess TestTransport{..} = do

@@ -1556,20 +1556,24 @@ testRegistryMonitoring :: TestTransport -> Assertion

1556testRegistryMonitoring TestTransport{..} = do

1557 node1 <- newLocalNode testTransport initRemoteTable

1558 node2 <- newLocalNode testTransport initRemoteTable

1559− waitH <- newEmptyMVar

1560

1559

1561 let nid = localNodeId node2

1560 let nid = localNodeId node2

1562 pid <- forkProcess node1 $ do

1561 pid <- forkProcess node1 $ do

1562+ self <- getSelfPid

1563− getSelfPid >>= runUntilRegistered nid

1563+ runUntilRegistered nid self

1564− liftIO $ takeMVar waitH

1564+ say $ (show self) ++ " registered as " ++ regName

1565+ expect :: Process ()

1566+ say $ (show self) ++ " exiting normally"

1565

1567

1566 runProcess node2 $ do

1568 runProcess node2 $ do

1567 register regName pid

1569 register regName pid

1570+ say $ regName ++ " registered to " ++ show pid

1568 res <- whereis regName

1571 res <- whereis regName

1572+ send pid ()

1573+ say $ " sent finish signal to " ++ show pid

1569 us <- getSelfPid

1574 us <- getSelfPid

1570− liftIO $ do

1571− putMVar waitH ()

1572− assertBool "expected (Just pid)" $ res == (Just pid)

1575+ liftIO $ assertBool "expected (Just pid)" $ res == (Just pid)

1576+

1573

1577

1574 -- This delay isn't essential!

1578 -- This delay isn't essential!

1575 -- The test case passes perfectly fine without it (feel free to comment out

1579 -- The test case passes perfectly fine without it (feel free to comment out

@@ -1594,7 +1598,9 @@ testRegistryMonitoring TestTransport{..} = do

1594 regHere <- newEmptyMVar

1598 regHere <- newEmptyMVar

1595 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere

1599 runProcess node2 $ whereis regName >>= liftIO . putMVar regHere

1596 res <- takeMVar regHere

1600 res <- takeMVar regHere

1601+ case res of

1602+ Nothing -> return ()

1597− assertBool "expected Nothing, but process still registered" (res == Nothing)

1603+ Just pid -> assertBool ("expected Nothing, but got " ++ show pid) False

1598

1604

1599 where

1605 where

1600 runUntilRegistered nid us = do

1606 runUntilRegistered nid us = do

@@ -1606,11 +1612,13 @@ testRegistryMonitoring TestTransport{..} = do

1606

1612

1607 delayUntilMaybeUnregistered nid p = do

1613 delayUntilMaybeUnregistered nid p = do

1608 whereisRemoteAsync nid regName

1614 whereisRemoteAsync nid regName

1609− receiveTimeout 20000000 {- 20 sec delay -} [

1615+ res <- receiveTimeout 20000000 {- 20 sec delay -} [

1610− matchIf (\(WhereIsReply n p) -> n == regName && p == Nothing)

1616+ matchIf (\(WhereIsReply n p) -> n == regName && isNothing p)

1611 (const $ return ())

1617 (const $ return ())

1612 ]

1618 ]

1619+ case res of

1613− return ()

1620+ Just () -> return ()

1621+ Nothing -> delayUntilMaybeUnregistered nid p

1614

1622

1615 regName = "testRegisterRemote"

1623 regName = "testRegisterRemote"

1616

1624

distributed-process-tests/src/Control/Distributed/Process/Tests/Internal/Utils.hs+3−1

@@ -91,6 +91,7 @@ import Test.HUnit (Assertion, assertFailure)

91import Test.HUnit.Base (assertBool)

93import GHC.Generics

94+import System.Timeout (timeout)

95-- | A mutable cell containing a test result.

96-- | A mutable cell containing a test result.

96type TestResult a = MVar a

97type TestResult a = MVar a

@@ -233,7 +234,8 @@ testProcessReport pid = do

233tryRunProcess :: LocalNode -> Process () -> IO ()

234tryRunProcess :: LocalNode -> Process () -> IO ()

234tryRunProcess node p = do

235tryRunProcess node p = do

235 tid <- liftIO myThreadId

236 tid <- liftIO myThreadId

237+ void $ timeout (1000000 * 60 * 5 :: Int) $

236− runProcess node $ catch p (\e -> liftIO $ throwTo tid (e::SomeException))

238+ runProcess node $ catch p (\e -> liftIO $ throwTo tid (e::SomeException))

237

239

238tryForkProcess :: LocalNode -> Process () -> IO ProcessId

240tryForkProcess :: LocalNode -> Process () -> IO ProcessId

239tryForkProcess node p = do

241tryForkProcess node p = do

distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+87−75

@@ -5,7 +5,6 @@ module Control.Distributed.Process.Tests.Mx (tests) where

6import Control.Distributed.Process.Tests.Internal.Utils

7import Network.Transport.Test (TestTransport(..))

8−import Control.Exception (SomeException)

9import Control.Distributed.Process hiding (bracket, finally, try)

8import Control.Distributed.Process hiding (bracket, finally, try)

10import Control.Distributed.Process.Internal.Types

9import Control.Distributed.Process.Internal.Types

11 ( ProcessExitException(..)

10 ( ProcessExitException(..)

@@ -39,7 +38,7 @@ import Control.Monad.Catch(finally, bracket, try)

39import Control.Rematch (equalTo)

38import Control.Rematch (equalTo)

40import Data.Binary

39import Data.Binary

41import Data.List (find, sort, intercalate)

40import Data.List (find, sort, intercalate)

42−import Data.Maybe (isJust, fromJust, isNothing, fromMaybe)

41+import Data.Maybe (isJust, fromJust, isNothing, fromMaybe, catMaybes)

43import Data.Typeable

42import Data.Typeable

44import GHC.Generics hiding (from)

43import GHC.Generics hiding (from)

45#if ! MIN_VERSION_base(4,6,0)

44#if ! MIN_VERSION_base(4,6,0)

@@ -67,7 +66,7 @@ awaitExit pid =

67 where

66 where

68 withMonitorRef p = bracket (monitor p) unmonitor

67 withMonitorRef p = bracket (monitor p) unmonitor

70−testAgentBroadcast :: TestResult () -> Process ()

69+testAgentBroadcast :: TestResult (Maybe ()) -> Process ()

71testAgentBroadcast result = do

70testAgentBroadcast result = do

72 (resultSP, resultRP) <- newChan :: Process (SendPort (), ReceivePort ())

71 (resultSP, resultRP) <- newChan :: Process (SendPort (), ReceivePort ())

@@ -82,10 +81,10 @@ testAgentBroadcast result = do

82 mxNotify ()

81 mxNotify ()

83 -- Once the publisher has seen our message, it will broadcast the Publish

82 -- Once the publisher has seen our message, it will broadcast the Publish

84 -- and the consumer will see that and send the result to our typed channel.

83 -- and the consumer will see that and send the result to our typed channel.

85− stash result =<< receiveChan resultRP

84+ stash result =<< receiveChanTimeout 10000000 resultRP

87− kill publisher "finished" >> awaitExit publisher

86+ kill publisher "finished"

88− kill consumer "finished" >> awaitExit consumer

87+ kill consumer "finished"

90testAgentDualInput :: TestResult (Maybe Int) -> Process ()

89testAgentDualInput :: TestResult (Maybe Int) -> Process ()

91testAgentDualInput result = do

90testAgentDualInput result = do

@@ -100,6 +99,8 @@ testAgentDualInput result = do

100 else mxReady)

99 else mxReady)

101 ]

100 ]

102

101

102+ mRef <- monitor s

103+

103 mxNotify (1 :: Int)

104 mxNotify (1 :: Int)

104 nsend "sum-agent" (3 :: Int)

105 nsend "sum-agent" (3 :: Int)

105 mxNotify (2 :: Int)

106 mxNotify (2 :: Int)

@@ -107,7 +108,10 @@ testAgentDualInput result = do

107 mxNotify (5 :: Int)

108 mxNotify (5 :: Int)

108

109

109 stash result =<< receiveChanTimeout 10000000 rp

110 stash result =<< receiveChanTimeout 10000000 rp

110− awaitExit s

111+ died <- receiveTimeout 10000000 [

112+ matchIf (\(ProcessMonitorNotification r _ _) -> r == mRef) (const $ return True)

113+ ]

114+ died `shouldBe` equalTo (Just True)

111

115

112testAgentPrioritisation :: TestResult [String] -> Process ()

116testAgentPrioritisation :: TestResult [String] -> Process ()

113testAgentPrioritisation result = do

117testAgentPrioritisation result = do

@@ -121,10 +125,10 @@ testAgentPrioritisation result = do

121 (sp, rp) <- newChan

125 (sp, rp) <- newChan

122 s <- mxAgent (MxAgentId name) ["first"] [

126 s <- mxAgent (MxAgentId name) ["first"] [

123 mxSink (\(s :: String) -> do

127 mxSink (\(s :: String) -> do

124− mxUpdateLocal ((s:))

128+ mxUpdateLocal (s:)

125 st <- mxGetLocal

129 st <- mxGetLocal

126 case length st of

130 case length st of

127− n | n == 5 -> do liftMX $ sendChan sp st

131+ n | n == 5 -> do liftMX $ sendChan sp (sort st)

128 mxDeactivate "finished"

132 mxDeactivate "finished"

129 _ -> mxReceive -- go to the mailbox

133 _ -> mxReceive -- go to the mailbox

130 )

134 )

@@ -135,7 +139,7 @@ testAgentPrioritisation result = do

135 mxNotify "fourth"

139 mxNotify "fourth"

136 nsend name "fifth"

140 nsend name "fifth"

137

141

138− stash result . sort =<< receiveChan rp

142+ stash result . fromMaybe [] =<< receiveChanTimeout 10000000 rp

139 awaitExit s

143 awaitExit s

140

144

141testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()

145testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()

@@ -148,12 +152,19 @@ testAgentMailboxHandling result = do

148 nsend "mailbox-agent" ()

152 nsend "mailbox-agent" ()

149

153

150 stash result =<< receiveChanTimeout 1000000 rp

154 stash result =<< receiveChanTimeout 1000000 rp

151− kill agent "finished" >> awaitExit agent

155+ kill agent "finished"

152

156

153testAgentEventHandling :: TestResult Bool -> Process ()

157testAgentEventHandling :: TestResult Bool -> Process ()

154testAgentEventHandling result = do

158testAgentEventHandling result = do

155− let initState = [] :: [MxEvent]

159+ us <- getSelfPid

160+ -- because this test is a bit racy, let's ensure it can't run indefinitely

161+ timer <- spawnLocal $ do

162+ pause (1000000 * 60 * 5)

163+ -- okay we've waited 5 mins, let's kill the test off if it's stuck...

164+ stash result False

165+ kill us "Test Timed Out"

156

166

167+ let initState = [] :: [MxEvent]

157 (rc, rs) <- newChan

168 (rc, rs) <- newChan

158 agentPid <- mxAgent (MxAgentId "lifecycle-listener-agent") initState [

169 agentPid <- mxAgent (MxAgentId "lifecycle-listener-agent") initState [

159 (mxSink $ \ev -> do

170 (mxSink $ \ev -> do

@@ -186,8 +197,7 @@ testAgentEventHandling result = do

186 -- TODO: yes, this is racy, but we're at the mercy of the scheduler here...

197 -- TODO: yes, this is racy, but we're at the mercy of the scheduler here...

187 faff 2000000 rs

198 faff 2000000 rs

188

199

189− _ <- monitor agentPid

190− (sp, rp) <- newChan

200+ (sp, rp) <- newChan :: Process (SendPort (), ReceivePort ())

191

201

192 pid <- spawnLocal $ expect >>= sendChan sp

202 pid <- spawnLocal $ expect >>= sendChan sp

193

203

@@ -196,9 +206,11 @@ testAgentEventHandling result = do

196 monitor pid

206 monitor pid

197

207

198 send pid ()

208 send pid ()

199− () <- receiveChan rp

209+ rct <- receiveChanTimeout 10000000 rp

210+ unless (isJust rct) $ die "No response on channel"

200

211

201− receiveWait [ match (\(ProcessMonitorNotification _ _ _) -> return ()) ]

212+ pmn <- receiveTimeout 2000000 [ match (\ProcessMonitorNotification{} -> return ()) ]

213+ unless (isJust pmn) $ die "No monitor notification arrived"

202

214

203 -- TODO: yes, this is racy, but we're at the mercy of the scheduler here...

215 -- TODO: yes, this is racy, but we're at the mercy of the scheduler here...

204 faff 2000000 rs

216 faff 2000000 rs

@@ -207,17 +219,16 @@ testAgentEventHandling result = do

207 mxNotify (MxSpawned pid, replyTo)

219 mxNotify (MxSpawned pid, replyTo)

208 mxNotify (MxProcessDied pid DiedNormal, replyTo)

220 mxNotify (MxProcessDied pid DiedNormal, replyTo)

209

221

210− seenAlive <- receiveChan reply

222+ seenAlive <- receiveChanTimeout 10000000 reply

211− seenDead <- receiveChan reply

223+ seenDead <- receiveChanTimeout 10000000 reply

212

224

213− stash result $ seenAlive && seenDead

225+ stash result $ foldr (&&) True $ catMaybes [seenAlive, seenDead]

214− kill agentPid "test-complete" >> awaitExit agentPid

226+ kill timer "test-complete"

227+ kill agentPid "test-complete"

215 where

228 where

216 faff delay port = do

229 faff delay port = do

217 res <- receiveChanTimeout delay port

230 res <- receiveChanTimeout delay port

218− unless (isNothing res) $ do

231+ unless (isNothing res) $ pause delay

219− pause delay

220− faff delay port

221

232

222testMxRegEvents :: TestResult () -> Process ()

233testMxRegEvents :: TestResult () -> Process ()

223testMxRegEvents result = do

234testMxRegEvents result = do

@@ -264,7 +275,6 @@ testMxRegEvents result = do

264 reg3 `shouldBe` equalTo (Just (label, p1))

275 reg3 `shouldBe` equalTo (Just (label, p1))

265

276

266 mapM_ (flip kill $ "test-complete") [agent, p1, p2]

277 mapM_ (flip kill $ "test-complete") [agent, p1, p2]

267− awaitExit agent

268

278

269testMxRegMon :: LocalNode -> TestResult () -> Process ()

279testMxRegMon :: LocalNode -> TestResult () -> Process ()

270testMxRegMon remoteNode result = do

280testMxRegMon remoteNode result = do

@@ -322,70 +332,70 @@ testMxRegMon remoteNode result = do

322 evts `shouldContain` (Just (label1, p1))

332 evts `shouldContain` (Just (label1, p1))

323 evts `shouldContain` (Just (label2, p1))

333 evts `shouldContain` (Just (label2, p1))

324

334

325− kill agent "test-complete" >> awaitExit agent

335+ kill agent "test-complete"

326

336

327ensure :: Process () -> Process () -> Process ()

337ensure :: Process () -> Process () -> Process ()

328ensure = flip finally

338ensure = flip finally

329

339

330testNSend :: (String -> () -> Process ())

340testNSend :: (String -> () -> Process ())

331 -> Maybe LocalNode

341 -> Maybe LocalNode

332− -> TestResult Bool

333 -> Process ()

342 -> Process ()

334−testNSend op n r = testMxSend n r $ \p1 sink -> do

343+testNSend op n = do

344+ us <- getSelfPid

335 let delay = 5000000

345 let delay = 5000000

336− let label = "testMxSend"

346+ let label = "testMxSend" ++ (show us)

337 let isValid = isValidLabel n label

347 let isValid = isValidLabel n label

338

348

349+ testMxSend n label $ \p1 sink -> do

339− register label p1

350+ register label p1

340− reg1 <- receiveChanTimeout delay sink

351+ reg1 <- receiveChanTimeout delay sink

341− case reg1 of

352+ case reg1 of

342− Just (MxRegistered pd lb)

353+ Just (MxRegistered pd lb)

343− | pd == p1 && isValid lb -> return ()

354+ | pd == p1 && isValid lb -> return ()

344− _ -> die $ "Reg-Failed: " ++ show reg1

355+ _ -> die $ "Reg-Failed: " ++ show reg1

345

356

346− op label ()

357+ op label ()

347

358

348− us <- getSelfPid

349− sent <- receiveChanTimeout delay sink

359+ sent <- receiveChanTimeout delay sink

350− case sent of

360+ case sent of

351− Just (MxSentToName lb by _)

361+ Just (MxSentToName lb by _)

352− | by == us && isValid lb -> return True

362+ | by == us && isValid lb -> return True

353− _ -> die $ "Send-Failed: " ++ show sent

363+ _ -> die $ "Send-Failed: " ++ show sent

354

364

355 where

365 where

356− isValidLabel n l1 l2

366+ isValidLabel nd l1 l2

357 | l2 == l2 = True

367 | l2 == l2 = True

358− | isJust n = l2 == l1 ++ "@" ++ show (localNodeId $ fromJust n)

368+ | isJust nd = l2 == l1 ++ "@" ++ show (localNodeId $ fromJust nd)

359 | otherwise = False

369 | otherwise = False

360

370

361testSend :: (ProcessId -> () -> Process ())

371testSend :: (ProcessId -> () -> Process ())

362 -> Maybe LocalNode

372 -> Maybe LocalNode

363− -> TestResult Bool

364 -> Process ()

373 -> Process ()

365−testSend op n r = testMxSend n r $ \p1 sink -> do

374+testSend op n = do

366− -- initiate a send

367− op p1 ()

368−

369− -- verify the management event

370 us <- getSelfPid

375 us <- getSelfPid

376+ let label = "testMxSend" ++ (show us)

377+ testMxSend n label $ \p1 sink -> do

378+ -- initiate a send

379+ op p1 ()

380+

381+ -- verify the management event

371− sent <- receiveChanTimeout 5000000 sink

382+ sent <- receiveChanTimeout 5000000 sink

372− case sent of

383+ case sent of

373− Just (MxSent pidTo pidFrom _)

384+ Just (MxSent pidTo pidFrom _)

374− | pidTo == p1 && pidFrom == us -> return True

385+ | pidTo == p1 && pidFrom == us -> return True

375− _ -> return False

386+ _ -> return False

376

387

377testChan :: (SendPort () -> () -> Process ())

388testChan :: (SendPort () -> () -> Process ())

378 -> Maybe LocalNode

389 -> Maybe LocalNode

379− -> TestResult Bool

380 -> Process ()

390 -> Process ()

381−testChan op n r = testMxSend n r $ \p1 sink -> do

391+testChan op n = testMxSend n "" $ \p1 sink -> do

382

392

383 us <- getSelfPid

393 us <- getSelfPid

384 send p1 us

394 send p1 us

385

395

386− cleared <- receiveChan sink

396+ cleared <- receiveChanTimeout 2000000 sink

387 case cleared of

397 case cleared of

388− (MxSent pidTo pidFrom _)

398+ Just (MxSent pidTo pidFrom _)

389 | pidTo == p1 && pidFrom == us -> return ()

399 | pidTo == p1 && pidFrom == us -> return ()

390 _ -> die "Received uncleared Mx Event"

400 _ -> die "Received uncleared Mx Event"

391

401

@@ -404,8 +414,8 @@ testChan op n r = testMxSend n r $ \p1 sink -> do

404

414

405type SendTest = ProcessId -> ReceivePort MxEvent -> Process Bool

415type SendTest = ProcessId -> ReceivePort MxEvent -> Process Bool

406

416

407−testMxSend :: Maybe LocalNode -> TestResult Bool -> SendTest -> Process ()

417+testMxSend :: Maybe LocalNode -> String -> SendTest -> Process ()

408−testMxSend mNode result test = do

418+testMxSend mNode label test = do

409 us <- getSelfPid

419 us <- getSelfPid

410 (sp, rp) <- newChan

420 (sp, rp) <- newChan

411 (chan, sink) <- newChan

421 (chan, sink) <- newChan

@@ -429,16 +439,19 @@ testMxSend mNode result test = do

429 Nothing -> void $ spawnLocal (proc sp)

439 Nothing -> void $ spawnLocal (proc sp)

430 Just remoteNode -> void $ liftIO $ forkProcess remoteNode $ proc sp

440 Just remoteNode -> void $ liftIO $ forkProcess remoteNode $ proc sp

431

441

432− p1 <- receiveChan rp

442+ p1 <- receiveChanTimeout 2000000 rp

443+ unless (isJust p1) $ die "Timed out waiting for ProcessId"

433− res <- try (test p1 sink)

444+ res <- try $ test (fromJust p1) sink

434− case res of

445+

435− Left (ProcessExitException _ m) -> (liftIO $ putStrLn $ "SomeException-" ++ show m) >> stash result False

436− Right tr -> stash result tr

437 kill agent "bye"

446 kill agent "bye"

438− kill p1 "bye"

447+ kill (fromJust p1) "bye"

448+

449+ case res of

450+ Left (ProcessExitException _ m) -> (liftIO $ putStrLn $ "SomeException-" ++ show m) >> die m

451+ Right tr -> tr `shouldBe` equalTo True

452+

439

453

440 where

454 where

441− label = "testMxSend"

442 agentLabel s = "mx-unsafe-check-agent-" ++ show s

455 agentLabel s = "mx-unsafe-check-agent-" ++ show s

443 proc sp' = getSelfPid >>= sendChan sp' >> go Nothing

456 proc sp' = getSelfPid >>= sendChan sp' >> go Nothing

444

457

@@ -464,7 +477,7 @@ tests TestTransport{..} = do

464 , testCase "InterAgentBroadcast"

477 , testCase "InterAgentBroadcast"

465 (delayedAssertion

478 (delayedAssertion

466 "expected (), but no broadcast was received"

479 "expected (), but no broadcast was received"

467− node1 () testAgentBroadcast)

480+ node1 (Just ()) testAgentBroadcast)

468 , testCase "AgentMailboxHandling"

481 , testCase "AgentMailboxHandling"

469 (delayedAssertion

482 (delayedAssertion

470 "expected (Just ()), but no regular (mailbox) input was handled"

483 "expected (Just ()), but no regular (mailbox) input was handled"

@@ -489,12 +502,11 @@ tests TestTransport{..} = do

489 (delayedAssertion

502 (delayedAssertion

490 "expected process deaths to result in unregistration events"

503 "expected process deaths to result in unregistration events"

491 node1 () (testMxRegMon node2))

504 node1 () (testMxRegMon node2))

492− -- , testGroup "SendEvents" $ buildTestCases node1 node2

505+ , testGroup "SendEvents" $ buildTestCases node1 node2

493 ]

506 ]

494 ]

507 ]

495 where

508 where

496− buildTestCases n1 n2 =

497− let nid = localNodeId n2 in build n2 [

509+ buildTestCases n1 n2 = let nid = localNodeId n2 in build n1 n2 [

498 ("NSend", [

510 ("NSend", [

499 ("nsend", testNSend nsend)

511 ("nsend", testNSend nsend)

500 , ("Unsafe.nsend", testNSend Unsafe.nsend)

512 , ("Unsafe.nsend", testNSend Unsafe.nsend)

@@ -516,13 +528,13 @@ tests TestTransport{..} = do

516 ]

528 ]

517

529

518 build :: LocalNode

530 build :: LocalNode

531+ -> LocalNode

519− -> [(String, [(String, (Maybe LocalNode -> TestResult Bool -> Process ()))])]

532+ -> [(String, [(String, (Maybe LocalNode -> Process ()))])]

520 -> [Test]

533 -> [Test]

521− build ln specs =

534+ build n ln specs =

522 [ testGroup (intercalate "-" [groupName, caseSuffix]) [

535 [ testGroup (intercalate "-" [groupName, caseSuffix]) [

523 testCase (intercalate "-" [caseName, caseSuffix])

536 testCase (intercalate "-" [caseName, caseSuffix])

524− (delayedAssertion "expected mx events failed"

525− ln True (caseImpl caseNode))

537+ (runProcess n (caseImpl caseNode))

526 | (caseName, caseImpl) <- groupCases

538 | (caseName, caseImpl) <- groupCases

527 ]

539 ]

528 | (groupName, groupCases) <- specs

540 | (groupName, groupCases) <- specs