master..f74c94d · distributed-process

git.iko.soy/distributed-process

on f74c94d 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/Internal/Utils.hs+1−3

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

91import Test.HUnit.Base (assertBool)

93import GHC.Generics

94−import System.Timeout (timeout)

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

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

97type TestResult a = MVar a

96type TestResult a = MVar a

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

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

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

235tryRunProcess node p = do

234tryRunProcess node p = do

236 tid <- liftIO myThreadId

235 tid <- liftIO myThreadId

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

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

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

239

237

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

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

241tryForkProcess node p = do

239tryForkProcess node p = do

distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+74−86

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

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

66 where

67 where

67 withMonitorRef p = bracket (monitor p) unmonitor

68 withMonitorRef p = bracket (monitor p) unmonitor

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

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

70testAgentBroadcast result = do

71testAgentBroadcast result = do

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

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

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

81 mxNotify ()

82 mxNotify ()

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

83 -- 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.

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

84− stash result =<< receiveChanTimeout 10000000 resultRP

85+ stash result =<< receiveChan resultRP

86− kill publisher "finished"

87+ kill publisher "finished" >> awaitExit publisher

87− kill consumer "finished"

88+ kill consumer "finished" >> awaitExit consumer

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

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

90testAgentDualInput result = do

91testAgentDualInput result = do

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

99 else mxReady)

100 else mxReady)

100 ]

101 ]

101

102

102− mRef <- monitor s

103−

104 mxNotify (1 :: Int)

103 mxNotify (1 :: Int)

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

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

106 mxNotify (2 :: Int)

105 mxNotify (2 :: Int)

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

108 mxNotify (5 :: Int)

107 mxNotify (5 :: Int)

109

108

110 stash result =<< receiveChanTimeout 10000000 rp

109 stash result =<< receiveChanTimeout 10000000 rp

111− died <- receiveTimeout 10000000 [

110+ awaitExit s

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

113− ]

114− died `shouldBe` equalTo (Just True)

115

111

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

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

117testAgentPrioritisation result = do

113testAgentPrioritisation result = do

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

125 (sp, rp) <- newChan

121 (sp, rp) <- newChan

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

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

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

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

128− mxUpdateLocal (s:)

124+ mxUpdateLocal ((s:))

129 st <- mxGetLocal

125 st <- mxGetLocal

130 case length st of

126 case length st of

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

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

132 mxDeactivate "finished"

128 mxDeactivate "finished"

133 _ -> mxReceive -- go to the mailbox

129 _ -> mxReceive -- go to the mailbox

134 )

130 )

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

139 mxNotify "fourth"

135 mxNotify "fourth"

140 nsend name "fifth"

136 nsend name "fifth"

141

137

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

138+ stash result . sort =<< receiveChan rp

143 awaitExit s

139 awaitExit s

144

140

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

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

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

152 nsend "mailbox-agent" ()

148 nsend "mailbox-agent" ()

153

149

154 stash result =<< receiveChanTimeout 1000000 rp

150 stash result =<< receiveChanTimeout 1000000 rp

155− kill agent "finished"

151+ kill agent "finished" >> awaitExit agent

156

152

157testAgentEventHandling :: TestResult Bool -> Process ()

153testAgentEventHandling :: TestResult Bool -> Process ()

158testAgentEventHandling result = do

154testAgentEventHandling 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]

155 let initState = [] :: [MxEvent]

156+

168 (rc, rs) <- newChan

157 (rc, rs) <- newChan

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

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

170 (mxSink $ \ev -> do

159 (mxSink $ \ev -> do

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

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

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

198 faff 2000000 rs

187 faff 2000000 rs

199

188

189+ _ <- monitor agentPid

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

190+ (sp, rp) <- newChan

201

191

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

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

203

193

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

206 monitor pid

196 monitor pid

207

197

208 send pid ()

198 send pid ()

209− rct <- receiveChanTimeout 10000000 rp

199+ () <- receiveChan rp

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

211

200

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

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

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

214

202

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

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

216 faff 2000000 rs

204 faff 2000000 rs

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

219 mxNotify (MxSpawned pid, replyTo)

207 mxNotify (MxSpawned pid, replyTo)

220 mxNotify (MxProcessDied pid DiedNormal, replyTo)

208 mxNotify (MxProcessDied pid DiedNormal, replyTo)

221

209

222− seenAlive <- receiveChanTimeout 10000000 reply

210+ seenAlive <- receiveChan reply

223− seenDead <- receiveChanTimeout 10000000 reply

211+ seenDead <- receiveChan reply

224

212

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

213+ stash result $ seenAlive && seenDead

226− kill timer "test-complete"

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

227− kill agentPid "test-complete"

228 where

215 where

229 faff delay port = do

216 faff delay port = do

230 res <- receiveChanTimeout delay port

217 res <- receiveChanTimeout delay port

231− unless (isNothing res) $ pause delay

218+ unless (isNothing res) $ do

219+ pause delay

220+ faff delay port

232

221

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

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

234testMxRegEvents result = do

223testMxRegEvents result = do

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

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

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

276

265

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

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

267+ awaitExit agent

278

268

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

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

280testMxRegMon remoteNode result = do

270testMxRegMon remoteNode result = do

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

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

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

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

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

334

324

335− kill agent "test-complete"

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

336

326

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

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

338ensure = flip finally

328ensure = flip finally

339

329

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

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

341 -> Maybe LocalNode

331 -> Maybe LocalNode

332+ -> TestResult Bool

342 -> Process ()

333 -> Process ()

343−testNSend op n = do

334+testNSend op n r = testMxSend n r $ \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

363+ -> TestResult Bool

373 -> Process ()

364 -> Process ()

374−testSend op n = do

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

366+ -- initiate a send

367+ op p1 ()

368+

369+ -- verify the management event

375 us <- getSelfPid

370 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

371+ sent <- receiveChanTimeout 5000000 sink

383− case sent of

372+ case sent of

384− Just (MxSent pidTo pidFrom _)

373+ Just (MxSent pidTo pidFrom _)

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

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

386− _ -> return False

375+ _ -> return False

387

376

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

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

389 -> Maybe LocalNode

378 -> Maybe LocalNode

379+ -> TestResult Bool

390 -> Process ()

380 -> Process ()

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

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

392

382

393 us <- getSelfPid

383 us <- getSelfPid

394 send p1 us

384 send p1 us

395

385

396− cleared <- receiveChanTimeout 2000000 sink

386+ cleared <- receiveChan sink

397 case cleared of

387 case cleared of

398− Just (MxSent pidTo pidFrom _)

388+ (MxSent pidTo pidFrom _)

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

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

400 _ -> die "Received uncleared Mx Event"

390 _ -> die "Received uncleared Mx Event"

401

391

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

414

404

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

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

416

406

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

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

418−testMxSend mNode label test = do

408+testMxSend mNode result test = do

419 us <- getSelfPid

409 us <- getSelfPid

420 (sp, rp) <- newChan

410 (sp, rp) <- newChan

421 (chan, sink) <- newChan

411 (chan, sink) <- newChan

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

439 Nothing -> void $ spawnLocal (proc sp)

429 Nothing -> void $ spawnLocal (proc sp)

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

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

441

431

442− p1 <- receiveChanTimeout 2000000 rp

432+ p1 <- receiveChan rp

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

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

433+ res <- try (test p1 sink)

445−

446− kill agent "bye"

447− kill (fromJust p1) "bye"

448−

449 case res of

434 case res of

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

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

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

436+ Right tr -> stash result tr

452−

437+ kill agent "bye"

438+ kill p1 "bye"

453

439

454 where

440 where

441+ label = "testMxSend"

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

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

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

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

457

444

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

477 , testCase "InterAgentBroadcast"

464 , testCase "InterAgentBroadcast"

478 (delayedAssertion

465 (delayedAssertion

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

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

480− node1 (Just ()) testAgentBroadcast)

467+ node1 () testAgentBroadcast)

481 , testCase "AgentMailboxHandling"

468 , testCase "AgentMailboxHandling"

482 (delayedAssertion

469 (delayedAssertion

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

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

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

506 ]

493 ]

507 ]

494 ]

508 where

495 where

496+ buildTestCases n1 n2 =

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

497+ let nid = localNodeId n2 in build 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)

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

528 ]

516 ]

529

517

530 build :: LocalNode

518 build :: LocalNode

531− -> LocalNode

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

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

533 -> [Test]

520 -> [Test]

534− build n ln specs =

521+ build ln specs =

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

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

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

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

524+ (delayedAssertion "expected mx events failed"

537− (runProcess n (caseImpl caseNode))

525+ ln True (caseImpl caseNode))

538 | (caseName, caseImpl) <- groupCases

526 | (caseName, caseImpl) <- groupCases

539 ]

527 ]

540 | (groupName, groupCases) <- specs

528 | (groupName, groupCases) <- specs