master..7cb5ca7 · distributed-process

git.iko.soy/distributed-process

on 7cb5ca7 help sign in

.travis.yml+1−1

since splitsnapshots

unifiedsplit

@@ -1,6 +1,6 @@

1language: c

3−sudo: false

3+sudo: required

5matrix:

6 include:

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

@@ -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, isJust)

49+import Data.Maybe (isNothing)

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

51import Test.Framework (Test, testGroup)

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

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

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

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

56newtype Ping = Ping ProcessId

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

735testRemoteRegistry TestTransport{..} = do

736 node1 <- newLocalNode testTransport initRemoteTable

737 node2 <- newLocalNode testTransport initRemoteTable

738+ done <- newEmptyMVar

738

739

739 pingServer <- forkProcess node1 ping

740 pingServer <- forkProcess node1 ping

740 deadProcess <- forkProcess node1 (return ())

741 deadProcess <- forkProcess node1 (return ())

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

749

750

750 pid <- verifyWhereIsRemote nid1 "ping"

751 pid <- verifyWhereIsRemote nid1 "ping"

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

752 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 [

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

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

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

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

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

765−

766 registerRemoteAsync nid1 "ping" deadProcess

765 registerRemoteAsync nid1 "ping" deadProcess

767 receiveWait [

766 receiveWait [

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

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

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

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

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

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

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

772−

773 unregisterRemoteAsync nid1 "dead"

770 unregisterRemoteAsync nid1 "dead"

774 receiveWait [

771 receiveWait [

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

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

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,24 +1556,20 @@ testRegistryMonitoring :: TestTransport -> Assertion

1556testRegistryMonitoring TestTransport{..} = do

1557 node1 <- newLocalNode testTransport initRemoteTable

1558 node2 <- newLocalNode testTransport initRemoteTable

1559+ waitH <- newEmptyMVar

1559

1560

1560 let nid = localNodeId node2

1561 let nid = localNodeId node2

1561 pid <- forkProcess node1 $ do

1562 pid <- forkProcess node1 $ do

1562− self <- getSelfPid

1563− runUntilRegistered nid self

1563+ getSelfPid >>= runUntilRegistered nid

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

1564+ liftIO $ takeMVar waitH

1565− expect :: Process ()

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

1567

1565

1568 runProcess node2 $ do

1566 runProcess node2 $ do

1569 register regName pid

1567 register regName pid

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

1571 res <- whereis regName

1568 res <- whereis regName

1572− send pid ()

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

1574 us <- getSelfPid

1569 us <- getSelfPid

1570+ liftIO $ do

1571+ putMVar waitH ()

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

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

1576−

1577

1573

1578 -- This delay isn't essential!

1574 -- This delay isn't essential!

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

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

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

1598 regHere <- newEmptyMVar

1594 regHere <- newEmptyMVar

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

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

1600 res <- takeMVar regHere

1596 res <- takeMVar regHere

1601− case res of

1602− Nothing -> return ()

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

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

1604

1598

1605 where

1599 where

1606 runUntilRegistered nid us = do

1600 runUntilRegistered nid us = do

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

1612

1606

1613 delayUntilMaybeUnregistered nid p = do

1607 delayUntilMaybeUnregistered nid p = do

1614 whereisRemoteAsync nid regName

1608 whereisRemoteAsync nid regName

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

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

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

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

1617 (const $ return ())

1611 (const $ return ())

1618 ]

1612 ]

1619− case res of

1620− Just () -> return ()

1613+ return ()

1621− Nothing -> delayUntilMaybeUnregistered nid p

1622

1614

1623 regName = "testRegisterRemote"

1615 regName = "testRegisterRemote"

1624

1616

distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+70−81

@@ -5,6 +5,7 @@ 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)

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

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

9import Control.Distributed.Process.Internal.Types

10import Control.Distributed.Process.Internal.Types

10 ( ProcessExitException(..)

11 ( ProcessExitException(..)

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

38import Control.Rematch (equalTo)

39import Control.Rematch (equalTo)

39import Data.Binary

40import Data.Binary

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

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

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

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

42import Data.Typeable

43import Data.Typeable

43import GHC.Generics hiding (from)

44import GHC.Generics hiding (from)

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

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

@@ -49,6 +50,7 @@ import Test.Framework

49 ( Test

50 ( Test

50 , testGroup

51 , testGroup

51 )

52 )

53+import Test.HUnit (Assertion)

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

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

54data Publish = Publish

56data Publish = Publish

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

66 where

68 where

67 withMonitorRef p = bracket (monitor p) unmonitor

69 withMonitorRef p = bracket (monitor p) unmonitor

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

71+testAgentBroadcast :: TestResult () -> Process ()

70testAgentBroadcast result = do

72testAgentBroadcast result = do

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

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

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

81 mxNotify ()

83 mxNotify ()

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

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

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

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

84− stash result =<< receiveChanTimeout 10000000 resultRP

86+ stash result =<< receiveChan resultRP

86− kill publisher "finished"

88+ kill publisher "finished" >> awaitExit publisher

87− kill consumer "finished"

89+ kill consumer "finished" >> awaitExit consumer

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

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

90testAgentDualInput result = do

92testAgentDualInput result = do

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

99 else mxReady)

101 else mxReady)

100 ]

102 ]

101

103

102− mRef <- monitor s

103−

104 mxNotify (1 :: Int)

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

106 mxNotify (2 :: Int)

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

108 mxNotify (5 :: Int)

109

110 stash result =<< receiveChanTimeout 10000000 rp

111− died <- receiveTimeout 10000000 [

111+ awaitExit s

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

113− ]

114− died `shouldBe` equalTo (Just True)

115

112

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

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

117testAgentPrioritisation result = do

114testAgentPrioritisation result = do

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

125 (sp, rp) <- newChan

122 (sp, rp) <- newChan

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

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

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

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

128− mxUpdateLocal (s:)

125+ mxUpdateLocal ((s:))

129 st <- mxGetLocal

126 st <- mxGetLocal

130 case length st of

127 case length st of

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

128+ n | n == 5 -> do liftMX $ sendChan sp st

132 mxDeactivate "finished"

129 mxDeactivate "finished"

133 _ -> mxReceive -- go to the mailbox

130 _ -> mxReceive -- go to the mailbox

134 )

131 )

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

139 mxNotify "fourth"

136 mxNotify "fourth"

140 nsend name "fifth"

137 nsend name "fifth"

141

138

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

139+ stash result . sort =<< receiveChan rp

143 awaitExit s

140 awaitExit s

144

141

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

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

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

152 nsend "mailbox-agent" ()

149 nsend "mailbox-agent" ()

153

150

154 stash result =<< receiveChanTimeout 1000000 rp

151 stash result =<< receiveChanTimeout 1000000 rp

155− kill agent "finished"

152+ kill agent "finished" >> awaitExit agent

156

153

157testAgentEventHandling :: TestResult Bool -> Process ()

154testAgentEventHandling :: TestResult Bool -> Process ()

158testAgentEventHandling result = do

155testAgentEventHandling result = do

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"

166−

167 let initState = [] :: [MxEvent]

156 let initState = [] :: [MxEvent]

157+

168 (rc, rs) <- newChan

158 (rc, rs) <- newChan

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

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

170 (mxSink $ \ev -> do

160 (mxSink $ \ev -> do

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

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

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

198 faff 2000000 rs

188 faff 2000000 rs

199

189

190+ _ <- monitor agentPid

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

191+ (sp, rp) <- newChan

201

192

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

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

203

194

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

206 monitor pid

197 monitor pid

207

198

208 send pid ()

199 send pid ()

209− rct <- receiveChanTimeout 10000000 rp

200+ () <- receiveChan rp

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

211

201

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

202+ receiveWait [ match (\(ProcessMonitorNotification _ _ _) -> return ()) ]

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

214

203

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

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

216 faff 2000000 rs

205 faff 2000000 rs

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

219 mxNotify (MxSpawned pid, replyTo)

208 mxNotify (MxSpawned pid, replyTo)

220 mxNotify (MxProcessDied pid DiedNormal, replyTo)

209 mxNotify (MxProcessDied pid DiedNormal, replyTo)

221

210

222− seenAlive <- receiveChanTimeout 10000000 reply

211+ seenAlive <- receiveChan reply

223− seenDead <- receiveChanTimeout 10000000 reply

212+ seenDead <- receiveChan reply

224

213

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

214+ stash result $ seenAlive && seenDead

226− kill timer "test-complete"

215+ kill agentPid "test-complete" >> awaitExit agentPid

227− kill agentPid "test-complete"

228 where

216 where

229 faff delay port = do

217 faff delay port = do

230 res <- receiveChanTimeout delay port

218 res <- receiveChanTimeout delay port

231− unless (isNothing res) $ pause delay

219+ unless (isNothing res) $ do

220+ pause delay

221+ faff delay port

232

222

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

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

234testMxRegEvents result = do

224testMxRegEvents result = do

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

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

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

276

266

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

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

268+ awaitExit agent

278

269

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

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

280testMxRegMon remoteNode result = do

271testMxRegMon remoteNode result = do

@@ -332,7 +323,7 @@ testMxRegMon remoteNode result = do

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

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

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

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

334

325

335− kill agent "test-complete"

326+ kill agent "test-complete" >> awaitExit agent

336

327

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

328ensure :: Process () -> Process () -> Process ()

338ensure = flip finally

329ensure = flip finally

@@ -340,62 +331,59 @@ ensure = flip finally

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

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

341 -> Maybe LocalNode

332 -> Maybe LocalNode

342 -> Process ()

333 -> Process ()

343−testNSend op n = do

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

344− us <- getSelfPid

345 let delay = 5000000

335 let delay = 5000000

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

336+ let label = "testMxSend"

347 let isValid = isValidLabel n label

337 let isValid = isValidLabel n label

348

338

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

350− register label p1

339+ register label p1

351− reg1 <- receiveChanTimeout delay sink

340+ reg1 <- receiveChanTimeout delay sink

352− case reg1 of

341+ case reg1 of

353− Just (MxRegistered pd lb)

342+ Just (MxRegistered pd lb)

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

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

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

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

356

345

357− op label ()

346+ op label ()

358

347

348+ us <- getSelfPid

359− sent <- receiveChanTimeout delay sink

349+ sent <- receiveChanTimeout delay sink

360− case sent of

350+ case sent of

361− Just (MxSentToName lb by _)

351+ Just (MxSentToName lb by _)

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

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

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

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

364

354

365 where

355 where

366− isValidLabel nd l1 l2

356+ isValidLabel n l1 l2

367 | l2 == l2 = True

357 | l2 == l2 = True

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

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

369 | otherwise = False

359 | otherwise = False

370

360

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

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

372 -> Maybe LocalNode

362 -> Maybe LocalNode

373 -> Process ()

363 -> Process ()

374−testSend op n = do

364+testSend op n = testMxSend n $ \p1 sink -> do

365+ -- initiate a send

366+ op p1 ()

367+

368+ -- verify the management event

375 us <- getSelfPid

369 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

382− sent <- receiveChanTimeout 5000000 sink

370+ sent <- receiveChanTimeout 5000000 sink

383− case sent of

371+ case sent of

384− Just (MxSent pidTo pidFrom _)

372+ Just (MxSent pidTo pidFrom _)

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

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

386− _ -> return False

374+ _ -> return False

387

375

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

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

389 -> Maybe LocalNode

377 -> Maybe LocalNode

390 -> Process ()

378 -> Process ()

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

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

392

380

393 us <- getSelfPid

381 us <- getSelfPid

394 send p1 us

382 send p1 us

395

383

396− cleared <- receiveChanTimeout 2000000 sink

384+ cleared <- receiveChan sink

397 case cleared of

385 case cleared of

398− Just (MxSent pidTo pidFrom _)

386+ (MxSent pidTo pidFrom _)

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

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

400 _ -> die "Received uncleared Mx Event"

388 _ -> die "Received uncleared Mx Event"

401

389

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

414

402

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

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

416

404

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

405+testMxSend :: Maybe LocalNode -> SendTest -> Process ()

418−testMxSend mNode label test = do

406+testMxSend mNode test = do

419 us <- getSelfPid

407 us <- getSelfPid

420 (sp, rp) <- newChan

408 (sp, rp) <- newChan

421 (chan, sink) <- newChan

409 (chan, sink) <- newChan

@@ -439,12 +427,11 @@ testMxSend mNode label test = do

439 Nothing -> void $ spawnLocal (proc sp)

427 Nothing -> void $ spawnLocal (proc sp)

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

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

441

429

442− p1 <- receiveChanTimeout 2000000 rp

430+ p1 <- receiveChan rp

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

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

431+ res <- try (test p1 sink)

445

432

446 kill agent "bye"

433 kill agent "bye"

447− kill (fromJust p1) "bye"

434+ kill p1 "bye"

448

435

449 case res of

436 case res of

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

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

@@ -452,6 +439,7 @@ testMxSend mNode label test = do

452

439

453

440

454 where

441 where

442+ label = "testMxSend"

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

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

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

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

457

445

@@ -465,7 +453,7 @@ testMxSend mNode label test = do

465 return r

453 return r

466

454

467tests :: TestTransport -> IO [Test]

455tests :: TestTransport -> IO [Test]

468−tests TestTransport{..} = do

456+tests tt@TestTransport{..} = do

469 node1 <- newLocalNode testTransport initRemoteTable

457 node1 <- newLocalNode testTransport initRemoteTable

470 node2 <- newLocalNode testTransport initRemoteTable

458 node2 <- newLocalNode testTransport initRemoteTable

471 return [

459 return [

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

477 , testCase "InterAgentBroadcast"

465 , testCase "InterAgentBroadcast"

478 (delayedAssertion

466 (delayedAssertion

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

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

480− node1 (Just ()) testAgentBroadcast)

468+ node1 () testAgentBroadcast)

481 , testCase "AgentMailboxHandling"

469 , testCase "AgentMailboxHandling"

482 (delayedAssertion

470 (delayedAssertion

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

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

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

502 (delayedAssertion

490 (delayedAssertion

503 "expected process deaths to result in unregistration events"

491 "expected process deaths to result in unregistration events"

504 node1 () (testMxRegMon node2))

492 node1 () (testMxRegMon node2))

505− , testGroup "SendEvents" $ buildTestCases node1 node2

493+ , testGroup "SendEvents" $ buildTestCases tt node2

506 ]

494 ]

507 ]

495 ]

508 where

496 where

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

497+ buildTestCases tt' n2 = let nid = localNodeId n2 in build tt' n2 [

510 ("NSend", [

498 ("NSend", [

511 ("nsend", testNSend nsend)

499 ("nsend", testNSend nsend)

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

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

@@ -527,14 +515,15 @@ tests TestTransport{..} = do

527 ])

515 ])

528 ]

516 ]

529

517

530− build :: LocalNode

518+ build :: TestTransport

531 -> LocalNode

519 -> LocalNode

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

520 -> [(String, [(String, (Maybe LocalNode -> Process ()))])]

533 -> [Test]

521 -> [Test]

534− build n ln specs =

522+ build TestTransport{..} ln specs =

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

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

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

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

525+ (newLocalNode testTransport initRemoteTable >>= \n ->

537− (runProcess n (caseImpl caseNode))

526+ tryRunProcess n (caseImpl caseNode))

538 | (caseName, caseImpl) <- groupCases

527 | (caseName, caseImpl) <- groupCases

539 ]

528 ]

540 | (groupName, groupCases) <- specs

529 | (groupName, groupCases) <- specs