f74c94d..master · distributed-process

git.iko.soy/distributed-process

on master help sign in

.travis.yml+1−1

since splitsnapshots

unifiedsplit

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

1language: c

3−sudo: required

3+sudo: false

5matrix:

6 include:

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

@@ -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+86−74

@@ -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"

@@ -493,8 +506,7 @@ tests TestTransport{..} = do

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