@@ -25,21 +25,29 @@ import Control.Concurrent.MVar
2525 )
2626import Control.Monad (replicateM_, replicateM, forever, void, unless, join)
2727import Control.Exception (SomeException, throwIO, ErrorCall(..))
28−import qualified Control.Exception as Ex (catch)
29−import Control.Applicative ((<$>), (<*>), pure, (<|>))
28+import Control.Monad.Catch (try, catch, finally, mask, onException)
29+import Control.Applicative ((<|>))
3030import qualified Network.Transport as NT (closeEndPoint, EndPointAddress)
31−import Control.Distributed.Process
31+import Control.Distributed.Process hiding
32+ ( try
33+ , catch
34+ , finally
35+ , mask
36+ , onException
37+ )
3238import Control.Distributed.Process.Internal.Types
33− ( NodeId(nodeAddress)
34− , LocalNode(localEndPoint)
39+ ( LocalNode(localEndPoint)
3540 , ProcessExitException(..)
3641 , nullProcessId
3742 , createUnencodedMessage
3843 )
3944import Control.Distributed.Process.Node
45+import Control.Distributed.Process.Debug
46+import Control.Distributed.Process.Management.Internal.Types
47+import Control.Distributed.Process.Tests.Internal.Utils (shouldBe)
4048import Control.Distributed.Process.Serializable (Serializable)
4149
42−import Test.HUnit (Assertion, assertFailure)
50+import Test.HUnit (Assertion, assertBool, assertFailure)
4351import Test.Framework (Test, testGroup)
4452import Test.Framework.Providers.HUnit (testCase)
4553import Control.Rematch hiding (match)
@@ -65,7 +73,7 @@ expectThat a matcher = case res of
6573forkTry :: IO () -> IO ThreadId
6674forkTry p = do
6775 tid <- myThreadId
68− forkIO $ Ex.catch p (\e -> throwTo tid (e :: SomeException))
76+ forkIO $ catch p (\e -> throwTo tid (e :: SomeException))
6977
7078-- | The ping server from the paper
7179ping :: Process ()
@@ -75,12 +83,47 @@ ping = do
7583 send partner (Ping self)
7684 ping
7785
86+verifyClient :: String -> MVar Bool -> IO ()
87+verifyClient s b = takeMVar b >>= assertBool s
88+
89+expectPing :: MVar Bool -> Process ()
90+expectPing mv = expect >>= liftIO . putMVar mv . checkPing
91+ where
92+ checkPing (Ping _) = True
93+ checkPing _ = False
94+
7895-- | Quick and dirty synchronous version of whereisRemoteAsync
7996whereisRemote :: NodeId -> String -> Process (Maybe ProcessId)
8097whereisRemote nid string = do
8198 whereisRemoteAsync nid string
82− WhereIsReply _ mPid <- expect
83− return mPid
99+ receiveWait [
100+ match (\(WhereIsReply _ mPid) -> return mPid)
101+ ]
102+
103+verifyWhereIsRemote :: NodeId -> String -> Process ProcessId
104+verifyWhereIsRemote n s = whereisRemote n s >>= maybe (die "remote name not found") return
105+
106+waitForExit :: ProcessId -> Process DiedReason
107+waitForExit pid = monitor pid >>= waitForDown
108+
109+waitForDown :: MonitorRef -> Process DiedReason
110+waitForDown ref =
111+ receiveWait [ matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
112+ (\(ProcessMonitorNotification _ _ dr) -> return dr) ]
113+
114+syncBreakConnection :: (NT.EndPointAddress -> NT.EndPointAddress -> IO ()) -> LocalNode -> LocalNode -> IO ()
115+syncBreakConnection breakConnection nid0 nid1 = do
116+ m <- newEmptyMVar
117+ _ <- forkProcess nid1 $ getSelfPid >>= liftIO . putMVar m
118+ runProcess nid0 $ do
119+ them <- liftIO $ takeMVar m
120+ pinger <- spawnLocal $ forever $ send them ()
121+ _ <- monitorNode (localNodeId nid1)
122+ liftIO $ breakConnection (nodeAddress $ localNodeId nid0)
123+ (nodeAddress $ localNodeId nid1)
124+ NodeMonitorNotification _ _ _ <- expect
125+ kill pinger "finished"
126+ return ()
84127
85128data Add = Add ProcessId Double Double deriving (Typeable)
86129data Divide = Divide ProcessId Double Double deriving (Typeable)
@@ -155,12 +198,18 @@ monitorTestProcess theirAddr mOrL un reason monitorSetup done =
155198 unmonitor ref
156199 liftIO $ putMVar done ()
157200 (False, ref) -> do
158− ProcessMonitorNotification ref' pid reason' <- expect
159− True <- return $ Just ref' == ref && pid == theirAddr && mOrL && reason == reason'
160− liftIO $ putMVar done ()
201+ receiveWait [
202+ match (\(ProcessMonitorNotification ref' pid reason') -> do
203+ liftIO $ do
204+ assertBool "Bad Monitor Signal"
205+ (Just ref' == ref && pid == theirAddr &&
206+ mOrL && reason == reason')
207+ putMVar done ())
208+ ]
161209 )
162210 (\(ProcessLinkException pid reason') -> do
163− True <- return $ pid == theirAddr && not mOrL && not un && reason == reason'
211+ (liftIO $ assertBool "link exception unmatched" $
212+ pid == theirAddr && not mOrL && not un && reason == reason')
164213 liftIO $ putMVar done ()
165214 )
166215
@@ -191,8 +240,10 @@ testPing TestTransport{..} = do
191240 pid <- getSelfPid
192241 replicateM_ numPings $ do
193242 send pingServer (Pong pid)
194− Ping _ <- expect
195− return ()
243+ p <- expect
244+ case p of
245+ Ping _ -> return ()
246+ _ -> die "Unexpected message"
196247
197248 putMVar clientDone ()
198249
@@ -279,7 +330,7 @@ testMonitorLocalDeadProcess TestTransport{..} mOrL un = do
279330 runProcess localNode $ do
280331 monitor theirAddr
281332 -- wait for the process to die
282− ProcessMonitorNotification _ _ _ <- expect
333+ expect :: Process ProcessMonitorNotification
283334 monitorTestProcess theirAddr mOrL un DiedUnknownId Nothing done
284335
285336 takeMVar done
@@ -353,14 +404,17 @@ testMath TestTransport{..} = do
353404 runProcess localNode $ do
354405 pid <- getSelfPid
355406 send mathServer (Add pid 1 2)
356− 3 <- expect :: Process Double
407+ three <- expect :: Process Double
357408 send mathServer (Divide pid 8 2)
358− 4 <- expect :: Process Double
409+ four <- expect :: Process Double
359410 send mathServer (Divide pid 8 0)
360− DivByZero <- expect
361− liftIO $ putMVar clientDone ()
411+ divByZ <- expect
412+ liftIO $ putMVar clientDone (three, four, divByZ)
362413
363− takeMVar clientDone
414+ res <- takeMVar clientDone
415+ case res of
416+ (3, 4, DivByZero) -> return ()
417+ _ -> error $ "Something went horribly wrong"
364418
365419-- | Send first message (i.e. connect) to an already terminated process
366420-- (without monitoring); then send another message to a second process on
@@ -388,11 +442,9 @@ testSendToTerminated TestTransport{..} = do
388442 pid <- getSelfPid
389443 send server1 "Hi"
390444 send server2 (Pong pid)
391− Ping pid' <- expect
392− True <- return $ pid' == server2
393− liftIO $ putMVar clientDone ()
445+ expectPing clientDone
394446
395− takeMVar clientDone
447+ verifyClient "Expected Ping from server" clientDone
396448
397449-- | Test (non-zero) timeout
398450testTimeout :: TestTransport -> Assertion
@@ -401,10 +453,10 @@ testTimeout TestTransport{..} = do
401453 done <- newEmptyMVar
402454
403455 runProcess localNode $ do
404− Nothing <- receiveTimeout 1000000 [match (\(Add _ _ _) -> return ())]
405− liftIO $ putMVar done ()
456+ res <- receiveTimeout 1000000 [match (\Add{} -> return ())]
457+ liftIO $ putMVar done $ res == Nothing
406458
407− takeMVar done
459+ verifyClient "Expected receiveTimeout to timeout..." done
408460
409461-- | Test zero timeout
410462testTimeout0 :: TestTransport -> Assertion
@@ -432,10 +484,9 @@ testTimeout0 TestTransport{..} = do
432484 -- is not interested in, and then a single message that it wants
433485 replicateM_ 10000 $ send server "Irrelevant message"
434486 send server (Pong pid)
435− Ping _ <- expect
436− liftIO $ putMVar clientDone ()
487+ expectPing clientDone
437488
438− takeMVar clientDone
489+ verifyClient "Expected Ping from server" clientDone
439490
440491-- | Test typed channels
441492testTypedChannels :: TestTransport -> Assertion
@@ -458,10 +509,10 @@ testTypedChannels TestTransport{..} = do
458509 runProcess localNode $ do
459510 (clientSendPort, rport) <- newChan
460511 sendChan serverSendPort (clientSendPort, 5)
461− False <- receiveChan rport
462− liftIO $ putMVar clientDone ()
512+ ch <- receiveChan rport
513+ liftIO $ putMVar clientDone $ ch == False
463514
464− takeMVar clientDone
515+ verifyClient "Expected channel to send 'False'" clientDone
465516
466517-- | Test merging receive ports
467518testMergeChannels :: TestTransport -> Assertion
@@ -484,9 +535,8 @@ testMergeChannels TestTransport{..} = do
484535 rs <- mapM charChannel "abc"
485536 m <- mergePorts biased rs
486537 xs <- replicateM 9 $ receiveChan m
487− True <- return $ xs == expected
488− liftIO $ putMVar done ()
489− takeMVar done
538+ liftIO $ putMVar done $ xs == expected
539+ verifyClient "Expected single layer merge to match expected ordering" done
490540
491541 -- Two layers of merging
492542 testNested :: LocalNode -> Bool -> Bool -> String -> IO ()
@@ -497,9 +547,8 @@ testMergeChannels TestTransport{..} = do
497547 ms <- mapM (mergePorts biasedInner) rss
498548 m <- mergePorts biasedOuter ms
499549 xs <- replicateM (9 * 3) $ receiveChan m
500− True <- return $ xs == expected
501− liftIO $ putMVar done ()
502− takeMVar done
550+ liftIO $ putMVar done $ xs == expected
551+ verifyClient "Expected nested channels to match expeted ordering" done
503552
504553 -- Test that if no messages are (immediately) available, the scheduler makes no difference
505554 testBlocked :: LocalNode -> Bool -> IO ()
@@ -508,43 +557,45 @@ testMergeChannels TestTransport{..} = do
508557 done <- newEmptyMVar
509558
510559 forkProcess localNode $ do
511− [sa, sb, sc] <- liftIO $ mapM readMVar vs
512− mapM_ ((>> liftIO (threadDelay 10000)) . uncurry sendChan)
513− [ -- a, b, c
514− (sa, 'a')
515− , (sb, 'b')
516− , (sc, 'c')
517− -- a, c, b
518− , (sa, 'a')
519− , (sc, 'c')
520− , (sb, 'b')
521− -- b, a, c
522− , (sb, 'b')
523− , (sa, 'a')
524− , (sc, 'c')
525− -- b, c, a
526− , (sb, 'b')
527− , (sc, 'c')
528− , (sa, 'a')
529− -- c, a, b
530− , (sc, 'c')
531− , (sa, 'a')
532− , (sb, 'b')
533− -- c, b, a
534− , (sc, 'c')
535− , (sb, 'b')
536− , (sa, 'a')
537− ]
560+ ss <- liftIO $ mapM readMVar vs
561+ case ss of
562+ [sa, sb, sc] ->
563+ mapM_ ((>> liftIO (threadDelay 10000)) . uncurry sendChan)
564+ [ -- a, b, c
565+ (sa, 'a')
566+ , (sb, 'b')
567+ , (sc, 'c')
568+ -- a, c, b
569+ , (sa, 'a')
570+ , (sc, 'c')
571+ , (sb, 'b')
572+ -- b, a, c
573+ , (sb, 'b')
574+ , (sa, 'a')
575+ , (sc, 'c')
576+ -- b, c, a
577+ , (sb, 'b')
578+ , (sc, 'c')
579+ , (sa, 'a')
580+ -- c, a, b
581+ , (sc, 'c')
582+ , (sa, 'a')
583+ , (sb, 'b')
584+ -- c, b, a
585+ , (sc, 'c')
586+ , (sb, 'b')
587+ , (sa, 'a')
588+ ]
589+ _ -> die "Something went horribly wrong"
538590
539591 forkProcess localNode $ do
540592 (ss, rs) <- unzip <$> replicateM 3 newChan
541593 liftIO $ mapM_ (uncurry putMVar) $ zip vs ss
542594 m <- mergePorts biased rs
543595 xs <- replicateM (6 * 3) $ receiveChan m
544− True <- return $ xs == "abcacbbacbcacabcba"
545− liftIO $ putMVar done ()
596+ liftIO $ putMVar done $ xs == "abcacbbacbcacabcba"
546597
547− takeMVar done
598+ verifyClient "Expected merged ports to match expected ordering" done
548599
549600 mergePorts :: Serializable a => Bool -> [ReceivePort a] -> Process (ReceivePort a)
550601 mergePorts True = mergePortsBiased
@@ -562,8 +613,9 @@ testTerminate TestTransport{..} = do
562613 localNode <- newLocalNode testTransport initRemoteTable
563614 runProcess localNode $ do
564615 e <- try terminate :: Process (Either ProcessTerminationException ())
565− True <- return $ either show show e == show ProcessTerminationException
566− return ()
616+ if either show show e == show ProcessTerminationException
617+ then return ()
618+ else die "Unexpected result from terminate"
567619
568620testMonitorNode :: TestTransport -> Assertion
569621testMonitorNode TestTransport{..} = do
@@ -574,11 +626,12 @@ testMonitorNode TestTransport{..} = do
574626
575627 runProcess node2 $ do
576628 ref <- monitorNode (localNodeId node1)
577− NodeMonitorNotification ref' nid DiedDisconnect <- expect
578− True <- return $ ref == ref' && nid == localNodeId node1
579− liftIO $ putMVar done ()
629+ receiveWait [
630+ match (\(NodeMonitorNotification ref' nid DiedDisconnect) ->
631+ return $ ref == ref' && nid == localNodeId node1)
632+ ] >>= liftIO . putMVar done
580633
581− takeMVar done
634+ verifyClient "Expected NodeMonitorNotification with matching ref & nodeId" done
582635
583636testMonitorLiveNode :: TestTransport -> Assertion
584637testMonitorLiveNode TestTransport{..} = do
@@ -593,15 +646,16 @@ testMonitorLiveNode TestTransport{..} = do
593646 liftIO $ putMVar ready ()
594647 liftIO $ takeMVar readyr
595648 send p ()
596− NodeMonitorNotification ref' nid _ <- expect
597− True <- return $ ref == ref' && nid == localNodeId node1
598− liftIO $ putMVar done ()
649+ receiveWait [
650+ match (\(NodeMonitorNotification ref' nid _) ->
651+ (return $ ref == ref' && nid == localNodeId node1))
652+ ] >>= liftIO . putMVar done
599653
600654 takeMVar ready
601655 closeLocalNode node1
602656 putMVar readyr ()
603657
604− takeMVar done
658+ verifyClient "Expected NodeMonitorNotification for LIVE node" done
605659
606660testMonitorChannel :: TestTransport -> Assertion
607661testMonitorChannel TestTransport{..} = do
@@ -611,18 +665,20 @@ testMonitorChannel TestTransport{..} = do
611665 pid <- forkProcess node1 $ do
612666 sport <- expect :: Process (SendPort ())
613667 ref <- monitorPort sport
614− PortMonitorNotification ref' port' reason <- expect
615− -- reason might be DiedUnknownId if the receive port is GCed before the
616− -- monitor is established (TODO: not sure that this is reasonable)
617− return $ ref' == ref && port' == sendPortId sport && (reason == DiedNormal || reason == DiedUnknownId)
618− liftIO $ putMVar gotNotification ()
668+ receiveWait [
669+ -- reason might be DiedUnknownId if the receive port is GCed before the
670+ -- monitor is established (TODO: not sure that this is reasonable)
671+ match (\(PortMonitorNotification ref' port' reason) ->
672+ return $ ref' == ref && port' == sendPortId sport &&
673+ (reason == DiedNormal || reason == DiedUnknownId))
674+ ] >>= liftIO . putMVar gotNotification
619675
620676 runProcess node2 $ do
621677 (sport, _) <- newChan :: Process (SendPort (), ReceivePort ())
622678 send pid sport
623679 liftIO $ threadDelay 100000
624680
625− takeMVar gotNotification
681+ verifyClient "Expected PortMonitorNotification" gotNotification
626682
627683testRegistry :: TestTransport -> Assertion
628684testRegistry TestTransport{..} = do
@@ -634,20 +690,28 @@ testRegistry TestTransport{..} = do
634690
635691 runProcess node $ do
636692 register "ping" pingServer
637− Just pid <- whereis "ping"
638− True <- return $ pingServer == pid
693+ whereis "ping" >>= liftIO . assertBool "Unexpected ping" . (== Just pingServer)
639694 us <- getSelfPid
640695 nsend "ping" (Pong us)
641− Ping pid' <- expect
642− True <- return $ pingServer == pid'
643− Left (ProcessRegistrationException "dead" Nothing) <- try $ register "dead" deadProcess
644− Left (ProcessRegistrationException "ping" (Just x)) <- try $ register "ping" deadProcess
645− True <- return $ x == pingServer
646− Left (ProcessRegistrationException "dead" Nothing) <- try $ unregister "dead"
696+ receiveWait [
697+ matchIf (\(Ping pid') -> pingServer == pid') (const $ return ())
698+ ]
699+ checkRegException "dead" Nothing deadProcess
700+ checkRegException "ping" (Just pingServer) deadProcess
701+ try (unregister "dead") >>= checkReg "dead" Nothing
647702 liftIO $ putMVar done ()
648703
649704 takeMVar done
650705
706+ where
707+ checkRegException name pid dead =
708+ try (register name dead) >>= checkReg name pid
709+
710+ checkReg name pid res =
711+ case res of
712+ Left (ProcessRegistrationException name pid) -> return ()
713+ _ -> die $ "Unexpected Registration" ++ show res
714+
651715testRegistryRemoteProcess :: TestTransport -> Assertion
652716testRegistryRemoteProcess TestTransport{..} = do
653717 node1 <- newLocalNode testTransport initRemoteTable
@@ -658,13 +722,13 @@ testRegistryRemoteProcess TestTransport{..} = do
658722
659723 runProcess node2 $ do
660724 register "ping" pingServer
661− Just pid <- whereis "ping"
662− True <- return $ pingServer == pid
725+ whereis "ping" >>= liftIO . assertBool "Unexpected ping" . (== Just pingServer)
663726 us <- getSelfPid
664727 nsend "ping" (Pong us)
665− Ping pid' <- expect
666− True <- return $ pingServer == pid'
667− liftIO $ putMVar done ()
728+ receiveWait [
729+ matchIf (\(Ping pid') -> pingServer == pid')
730+ (const $ liftIO $ putMVar done ())
731+ ]
668732
669733 takeMVar done
670734
@@ -685,12 +749,13 @@ testRemoteRegistry TestTransport{..} = do
685749 "ping" == label' && pid == pingServer)
686750 (\(RegisterReply _ _ _) -> return ()) ]
687751
688− Just pid <- whereisRemote nid1 "ping"
689− True <- return $ pingServer == pid
752+ pid <- verifyWhereIsRemote nid1 "ping"
753+ liftIO $ assertBool "Expected pindServer to match pid" $ pingServer == pid
690754 us <- getSelfPid
691755 nsendRemote nid1 "ping" (Pong us)
692− Ping pid' <- expect
693− True <- return $ pingServer == pid'
756+ receiveWait [
757+ match (\(Ping pid') -> return $ pingServer == pid')
758+ ] >>= liftIO . assertBool "Expected Ping with ping server's ProcessId"
694759
695760 -- test that if process was not registered Nothing is returned
696761 -- in owner field.
@@ -700,8 +765,8 @@ testRemoteRegistry TestTransport{..} = do
700765 (\(RegisterReply _ _ _) -> return ()) ]
701766 registerRemoteAsync nid1 "ping" deadProcess
702767 receiveWait [
703− matchIf (\(RegisterReply label' False (Just pid)) ->
704− "ping" == label' && pid == pingServer)
768+ matchIf (\(RegisterReply label' False (Just pid'')) ->
769+ "ping" == label' && pid'' == pingServer)
705770 (\(RegisterReply _ _ _) -> return ()) ]
706771 unregisterRemoteAsync nid1 "dead"
707772 receiveWait [
@@ -726,15 +791,15 @@ testRemoteRegistryRemoteProcess TestTransport{..} = do
726791 receiveWait [
727792 matchIf (\(RegisterReply label' _ _) -> "ping" == label')
728793 (\(RegisterReply _ _ _) -> return ()) ]
729− Just pid <- whereisRemote nid1 "ping"
730− True <- return $ pingServer == pid
794+ pid <- verifyWhereIsRemote nid1 "ping"
795+ liftIO $ assertBool "Expected pingServer to match remote name" $ pingServer == pid
731796 us <- getSelfPid
732797 nsendRemote nid1 "ping" (Pong us)
733− Ping pid' <- expect
734− True <- return $ pingServer == pid'
735− liftIO $ putMVar done ()
798+ receiveWait [
799+ match (\(Ping pid') -> return $ pingServer == pid')
800+ ] >>= liftIO . putMVar done
736801
737− takeMVar done
802+ verifyClient "Expected Ping with ping server's ProcessId" done
738803
739804testSpawnLocal :: TestTransport -> Assertion
740805testSpawnLocal TestTransport{..} = do
@@ -748,15 +813,14 @@ testSpawnLocal TestTransport{..} = do
748813 sport <- expect
749814 sendChan sport (1234 :: Int)
750815
751− sport <- spawnChannelLocal $ \rport -> do
752− (1234 :: Int) <- receiveChan rport
753− send us ()
816+ sport <- spawnChannelLocal $
817+ \rport -> (receiveChan rport :: Process Int) >>= send us
754818
755819 send pid sport
756− () <- expect
757− liftIO $ putMVar done ()
820+ expect >>= liftIO . putMVar done
758821
759− takeMVar done
822+ res <- takeMVar done
823+ assertBool "Expected 1234 :: Int" $ res == (1234 :: Int)
760824
761825testSpawnAsyncStrictness :: TestTransport -> Assertion
762826testSpawnAsyncStrictness TestTransport{..} = do
@@ -785,8 +849,9 @@ testReconnect TestTransport{..} = do
785849 liftIO $ putMVar processA us
786850 msg1 <- expect
787851 msg2 <- expect
788− True <- return $ msg1 == "message 1" && msg2 == "message 3"
789− liftIO $ putMVar sendTestOk ()
852+ liftIO $ do
853+ assertBool "messages did not match" $ msg1 == "message 1" && msg2 == "message 3"
854+ putMVar sendTestOk ()
790855
791856 forkProcess node2 $ do
792857 {-
@@ -819,7 +884,7 @@ testReconnect TestTransport{..} = do
819884 matchIf (\(RegisterReply label' _ _) -> "a" == label')
820885 (\(RegisterReply _ _ _) -> return ()) ]
821886
822− Just _ <- whereisRemote nid1 "a"
887+ _ <- whereisRemote nid1 "a"
823888
824889
825890 -- Simulate network failure
@@ -838,9 +903,10 @@ testReconnect TestTransport{..} = do
838903 (\(RegisterReply _ _ _) -> return ()) ]
839904
840905 -- Check
841− Nothing <- whereisRemote nid1 "a" -- this will fail because the name is removed when the node is disconnected
842− Just _ <- whereisRemote nid1 "b" -- this will suceed because the value is set after thereconnect
843− Just _ <- whereisRemote nid1 "c"
906+ mPid <- whereisRemote nid1 "a" -- this will fail because the name is removed when the node is disconnected
907+ liftIO $ assertBool "Expected remote name to be lost" $ mPid == Nothing
908+ verifyWhereIsRemote nid1 "b" -- this will suceed because the value is set after thereconnect
909+ verifyWhereIsRemote nid1 "c"
844910
845911 liftIO $ putMVar registerTestOk ()
846912
@@ -881,19 +947,19 @@ testUSend usendPrim TestTransport{..} numMessages = do
881947 isSorted _ = True
882948 -- The list can't be null since there are no failures after sending
883949 -- the last message.
884− True <- return $ isSorted msgs && not (null msgs)
885− liftIO $ putMVar usendTestOk ()
950+ liftIO $ putMVar usendTestOk $ isSorted msgs && not (null msgs)
886951
887952 forkProcess node2 $ do
888953 them <- liftIO $ readMVar processA
889954 getSelfPid >>= send them
890− () <- expect
955+ expect :: Process ()
891956 forM_ [1..numMessages] $ \i -> do
892957 liftIO $ testBreakConnection (nodeAddress nid1) (nodeAddress nid2)
893958 usendPrim them i
894959 liftIO (threadDelay 30000)
895960
896− takeMVar usendTestOk
961+ res <- takeMVar usendTestOk
962+ assertBool "Unexpected failure after sending last msg" res
897963
898964-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
899965-- in between
@@ -919,14 +985,17 @@ testMatchAny TestTransport{..} = do
919985 runProcess localNode $ do
920986 pid <- getSelfPid
921987 send mathServer (Add pid 1 2)
922− 3 <- expect :: Process Double
988+ three <- expect :: Process Double
923989 send mathServer (Divide pid 8 2)
924− 4 <- expect :: Process Double
990+ four <- expect :: Process Double
925991 send mathServer (Divide pid 8 0)
926− DivByZero <- expect
927− liftIO $ putMVar clientDone ()
992+ divByZ <- expect
993+ liftIO $ putMVar clientDone (three, four, divByZ)
928994
929− takeMVar clientDone
995+ res <- takeMVar clientDone
996+ case res of
997+ (3, 4, DivByZero) -> return ()
998+ _ -> error "Unexpected result"
930999
9311000-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
9321001-- in between, however we block 'Divide' requests ....
@@ -953,12 +1022,13 @@ testMatchAnyHandle TestTransport{..} = do
9531022 runProcess localNode $ do
9541023 pid <- getSelfPid
9551024 send mathServer (Add pid 1 2)
956− 3 <- expect :: Process Double
1025+ three <- expect :: Process Double
9571026 send mathServer (Divide pid 8 2)
958− Nothing <- (expectTimeout 100000) :: Process (Maybe Double)
959− liftIO $ putMVar clientDone ()
1027+ res <- (expectTimeout 100000) :: Process (Maybe Double)
1028+ liftIO $ putMVar clientDone $ three == 3 && res == Nothing
1029+
1030+ verifyClient "Expected Nothing (i.e. timeout)" clientDone
9601031
961− takeMVar clientDone
9621032 where maybeForward :: ProcessId -> Message -> Process (Maybe ())
9631033 maybeForward s msg =
9641034 handleMessage msg (\m@(Add _ _ _) -> send s m)
@@ -986,8 +1056,10 @@ testMatchAnyNoHandle TestTransport{..} = do
9861056 Just _ -> die "NONSENSE")
9871057 ]
9881058 -- we *must* have removed the message from our mailbox though!!!
989− Nothing <- receiveTimeout 100000 [ match (\(Add _ _ _) -> return ()) ]
990− liftIO $ putMVar serverDone ()
1059+ res <- receiveTimeout 100000 [ match (\(Add _ _ _) -> return ()) ]
1060+ liftIO $ do
1061+ assertBool "Expected timeout!" $ res == Nothing
1062+ putMVar serverDone ()
9911063 putMVar addr server
9921064
9931065 -- Client
@@ -1030,14 +1102,21 @@ testMatchAnyIf TestTransport{..} = do
10301102 runProcess localNode $ do
10311103 pid <- getSelfPid
10321104 send server (pid, "foo")
1033− "foo" <- expect
1034− send server (pid, "baz")
1035− "baz" <- expect
1105+ foo <- expect
1106+ -- provoking what would be the wrong ordering is informative here...
1107+
10361108 send server (pid, "bar")
1037− Nothing <- (expectTimeout 100000) :: Process (Maybe Double)
1038− liftIO $ putMVar clientDone ()
1109+ bar <- (expectTimeout 100000) :: Process (Maybe String) -- was Double o_O !?
1110+
1111+ send server (pid, "baz")
1112+ baz <- expect
1113+
1114+ liftIO $ putMVar clientDone (foo, bar, baz)
1115+
1116+ res <- takeMVar clientDone
1117+ let res' = res == ("foo", Nothing, "baz")
1118+ assertBool "Expected timeout due to type mismatch" res'
10391119
1040− takeMVar clientDone
10411120 where tryHandleMessage :: Message -> Process (Maybe ())
10421121 tryHandleMessage msg =
10431122 handleMessage msg (\(pid :: ProcessId, (m :: String))
@@ -1070,12 +1149,13 @@ testMatchMessageWithUnwrap TestTransport{..} = do
10701149 runProcess localNode $ do
10711150 pid <- getSelfPid
10721151 send server (pid, wrapMessage ("foo" :: String))
1073− "foo" <- expect
1152+ foo <- expect
10741153 send server (pid, wrapMessage ("baz" :: String))
1075− "baz" <- expect
1076− liftIO $ putMVar clientDone ()
1154+ baz <- expect
1155+ liftIO $ putMVar clientDone (foo, baz)
10771156
1078− takeMVar clientDone
1157+ res <- takeMVar clientDone
1158+ assertBool "Unexpected unwrapped results" $ res == ("foo", "baz")
10791159
10801160-- Test 'receiveChanTimeout'
10811161testReceiveChanTimeout :: TestTransport -> Assertion
@@ -1093,18 +1173,19 @@ testReceiveChanTimeout TestTransport{..} = do
10931173
10941174 -- Wait for a message with a delay. No message arrives, we should get
10951175 -- Nothing after the delay.
1096− Nothing <- receiveChanTimeout 100000 rp
1176+ receiveChanTimeout 100000 rp >>= maybe (return ()) (const $ die "Expected Timeout")
10971177
10981178 -- Let the sender know that it can send a message.
10991179 liftIO $ putMVar mvSender ()
11001180
11011181 -- Wait for a message with a delay again. Now a message arrives after
11021182 -- 0.1 seconds
1103− Just True <- receiveChanTimeout 20000000 rp
1183+ res <- receiveChanTimeout 20000000 rp >>= maybe (die "Timeout") return
1184+ liftIO $ assertBool "Expected result to be 'True'" res
11041185
11051186 -- Wait for a message with zero timeout: non-blocking check. No message is
11061187 -- available, we get Nothing
1107− Nothing <- receiveChanTimeout 0 rp
1188+ receiveChanTimeout 0 rp >>= maybe (return ()) (const $ die "Expected Timeout")
11081189
11091190 -- Let the sender know that it can send a message.
11101191 liftIO $ putMVar mvSender ()
@@ -1114,7 +1195,7 @@ testReceiveChanTimeout TestTransport{..} = do
11141195 liftIO $ threadDelay 100000
11151196 mb <- receiveChanTimeout 0 rp
11161197 case mb of
1117− Just b -> do False <- return b; return ()
1198+ Just b -> do liftIO $ assertBool "Unexpected Message" $ not b
11181199 _ -> loop
11191200
11201201 liftIO $ putMVar done ()
@@ -1151,8 +1232,8 @@ testReceiveChanFeatures TestTransport{..} = do
11511232
11521233 rp1 <- mergePortsBiased [even <$> rpInt, rpBool]
11531234
1154− True <- receiveChan rp1
1155− False <- receiveChan rp1
1235+ receiveChan rp1 >>= liftIO . assertBool "Expected True"
1236+ receiveChan rp1 >>= liftIO . assertBool "Expected False" . not
11561237
11571238 -- Test Applicative instance
11581239
@@ -1161,7 +1242,7 @@ testReceiveChanFeatures TestTransport{..} = do
11611242
11621243 let rp2 = pure (+) <*> rpInt <*> rpInt
11631244
1164− 7 <- receiveChan rp2
1245+ receiveChan rp2 >>= liftIO . assertBool "Expected 7" . (== 7)
11651246
11661247 -- Test Alternative instance
11671248
@@ -1170,8 +1251,8 @@ testReceiveChanFeatures TestTransport{..} = do
11701251
11711252 let rp3 = (even <$> rpInt) <|> rpBool
11721253
1173− False <- receiveChan rp3
1174− True <- receiveChan rp3
1254+ receiveChan rp3 >>= liftIO . assertBool "Expected False" . not
1255+ receiveChan rp3 >>= liftIO . assertBool "Expected True"
11751256
11761257 -- Test Monad instance
11771258
@@ -1185,8 +1266,8 @@ testReceiveChanFeatures TestTransport{..} = do
11851266 then rpInt
11861267 else return 7
11871268
1188− 5 <- receiveChan rp4
1189− 7 <- receiveChan rp4
1269+ receiveChan rp4 >>= liftIO . assertBool "Expected 5" . (== 5)
1270+ receiveChan rp4 >>= liftIO . assertBool "Expected 7" . (== 7)
11901271
11911272 liftIO $ putMVar done ()
11921273
@@ -1195,7 +1276,6 @@ testReceiveChanFeatures TestTransport{..} = do
11951276testKillLocal :: TestTransport -> Assertion
11961277testKillLocal TestTransport{..} = do
11971278 localNode <- newLocalNode testTransport initRemoteTable
1198− done <- newEmptyMVar
11991279
12001280 pid <- forkProcess localNode $ do
12011281 liftIO $ threadDelay 1000000
@@ -1204,17 +1284,18 @@ testKillLocal TestTransport{..} = do
12041284 ref <- monitor pid
12051285 us <- getSelfPid
12061286 kill pid "TestKill"
1207− ProcessMonitorNotification ref' pid' (DiedException ex) <- expect
1208− True <- return $ ref == ref' && pid == pid' && ex == "killed-by=" ++ show us ++ ",reason=TestKill"
1209− liftIO $ putMVar done ()
1210−
1211− takeMVar done
1287+ mn <- expect
1288+ case mn of
1289+ ProcessMonitorNotification ref' pid' (DiedException ex) ->
1290+ case ref == ref' && pid == pid' && ex == "killed-by=" ++ show us ++ ",reason=TestKill" of
1291+ True -> return ()
1292+ False -> die "Invalid ProcessMonitorNotification received"
1293+ _ -> die "Something went horribly wrong"
12121294
12131295testKillRemote :: TestTransport -> Assertion
12141296testKillRemote TestTransport{..} = do
12151297 node1 <- newLocalNode testTransport initRemoteTable
12161298 node2 <- newLocalNode testTransport initRemoteTable
1217− done <- newEmptyMVar
12181299
12191300 pid <- forkProcess node1 $ do
12201301 liftIO $ threadDelay 1000000
@@ -1223,11 +1304,17 @@ testKillRemote TestTransport{..} = do
12231304 ref <- monitor pid
12241305 us <- getSelfPid
12251306 kill pid "TestKill"
1226− ProcessMonitorNotification ref' pid' (DiedException reason) <- expect
1227− True <- return $ ref == ref' && pid == pid' && reason == "killed-by=" ++ show us ++ ",reason=TestKill"
1228− liftIO $ putMVar done ()
1229−
1230− takeMVar done
1307+ mn <- expect
1308+ case mn of
1309+ ProcessMonitorNotification ref' pid' (DiedException reason) ->
1310+ case (ref == ref', pid == pid', reason == "killed-by=" ++ show us ++ ",reason=TestKill") of
1311+ (True, True, True) -> return ()
1312+ (a, b, c) -> do
1313+ let a' = if a then "" else "Invalid ref"
1314+ let b' = if b then "" else "Invalid pid"
1315+ let c' = if c then "" else "Invalid message"
1316+ die $ unwords [a', b', c']
1317+ _ -> die "Received unexpected message"
12311318
12321319testCatchesExit :: TestTransport -> Assertion
12331320testCatchesExit TestTransport{..} = do
@@ -1253,7 +1340,10 @@ testHandleMessageIf TestTransport{..} = do
12531340 self <- getSelfPid
12541341 send self (5 :: Integer, 10 :: Integer)
12551342 msg <- receiveWait [ matchMessage return ]
1256− Nothing <- handleMessageIf msg (\() -> True) (\() -> die $ "whoops")
1343+ handleMessageIf msg
1344+ (\() -> True)
1345+ (\() -> die "whoops") >>= maybe (return ())
1346+ (const $ die "Expected Mismatch")
12571347 handleMessageIf msg (\(x :: Integer, y :: Integer) -> x == 5 && y == 10)
12581348 (\input -> liftIO $ putMVar done input)
12591349 return ()
@@ -1298,8 +1388,11 @@ testDie TestTransport{..} = do
12981388 (die ("foobar", 123 :: Int))
12991389 `catchExit` \_from reason -> do
13001390 -- TODO: should verify that 'from' has the right value
1301− True <- return $ reason == ("foobar", 123 :: Int)
1391+ let res = reason == ("foobar", 123 :: Int)
13021392 liftIO $ putMVar done ()
1393+ if res
1394+ then return ()
1395+ else die "Something went horribly wrong"
13031396
13041397 takeMVar done
13051398
@@ -1313,8 +1406,11 @@ testPrettyExit TestTransport{..} = do
13131406 `catch` \ex@(ProcessExitException from _) ->
13141407 let expected = "exit-from=" ++ (show from)
13151408 in do
1316− True <- return $ (show ex) == expected
1409+ let res = (show ex) == expected
13171410 liftIO $ putMVar done ()
1411+ if res
1412+ then return ()
1413+ else die "Something went horribly wrong"
13181414
13191415 takeMVar done
13201416
@@ -1330,17 +1426,26 @@ testExitLocal TestTransport{..} = do
13301426 pid <- forkProcess localNode $ do
13311427 (liftIO (putMVar handlerSetUp ()) >> expect) `catchExit` \_from reason -> do
13321428 -- TODO: should verify that 'from' has the right value
1333− True <- return $ reason == "TestExit"
1429+ res <- return $ reason == "TestExit"
13341430 liftIO $ putMVar supervisedDone ()
1431+ if res
1432+ then return ()
1433+ else die "Something went horribly wrong"
13351434
13361435 runProcess localNode $ do
13371436 liftIO $ takeMVar handlerSetUp
13381437 ref <- monitor pid
13391438 exit pid "TestExit"
13401439 -- This time the client catches the exception, so it dies normally
1341− ProcessMonitorNotification ref' pid' DiedNormal <- expect
1342− True <- return $ ref == ref' && pid == pid'
1343− liftIO $ putMVar supervisorDone ()
1440+ mn <- expect
1441+ case mn of
1442+ ProcessMonitorNotification ref' pid' DiedNormal -> do
1443+ let res = ref == ref' && pid == pid'
1444+ liftIO $ putMVar supervisorDone ()
1445+ if res
1446+ then return ()
1447+ else die "Something went horribly wrong"
1448+ _ -> die "Something went horribly wrong"
13441449
13451450 takeMVar supervisedDone
13461451 takeMVar supervisorDone
@@ -1356,19 +1461,90 @@ testExitRemote TestTransport{..} = do
13561461 (receiveWait [] :: Process ()) -- block forever
13571462 `catchExit` \_from reason -> do
13581463 -- TODO: should verify that 'from' has the right value
1359− True <- return $ reason == "TestExit"
1464+ res <- return $ reason == "TestExit"
13601465 liftIO $ putMVar supervisedDone ()
1466+ if res
1467+ then return ()
1468+ else die "Something went horribly wrong"
13611469
13621470 runProcess node2 $ do
13631471 ref <- monitor pid
13641472 exit pid "TestExit"
1365− ProcessMonitorNotification ref' pid' DiedNormal <- expect
1366− True <- return $ ref == ref' && pid == pid'
1367− liftIO $ putMVar supervisorDone ()
1473+ mn <- expect
1474+ case mn of
1475+ ProcessMonitorNotification ref' pid' DiedNormal -> do
1476+ res' <- return $ ref == ref' && pid == pid'
1477+ liftIO $ putMVar supervisorDone ()
1478+ if res'
1479+ then return ()
1480+ else die "Something went horribly wrong"
1481+ _ -> die "Something went horribly wrong"
13681482
13691483 takeMVar supervisedDone
13701484 takeMVar supervisorDone
13711485
1486+testRegistryMonitoring :: TestTransport -> Assertion
1487+testRegistryMonitoring TestTransport{..} = do
1488+ node1 <- newLocalNode testTransport initRemoteTable
1489+ node2 <- newLocalNode testTransport initRemoteTable
1490+ waitH <- newEmptyMVar
1491+
1492+ let nid = localNodeId node2
1493+ pid <- forkProcess node1 $ do
1494+ getSelfPid >>= runUntilRegistered nid
1495+ liftIO $ takeMVar waitH
1496+
1497+ runProcess node2 $ do
1498+ register regName pid
1499+ res <- whereis regName
1500+ us <- getSelfPid
1501+ liftIO $ do
1502+ putMVar waitH ()
1503+ assertBool "expected (Just pid)" $ res == (Just pid)
1504+
1505+ -- This delay isn't essential!
1506+ -- The test case passes perfectly fine without it (feel free to comment out
1507+ -- and see), however waiting a few seconds here, makes it much more likely
1508+ -- that in delayUntilMaybeUnregistered we will hit the match case right
1509+ -- away, and thus not be subjected to a 20 second delay. The value of 4
1510+ -- seconds appears to work optimally on osx and across several linux distros
1511+ -- running in virtual machines (which is essentially what we do in CI)
1512+ void $ receiveTimeout 4000000 [ matchAny return ]
1513+
1514+ -- This delay doesn't serve much purpose in the happy path, however if some
1515+ -- future patch breaks the cooperative behaviour of node controllers viz
1516+ -- remote process registration and notification taking place via ncEffectDied,
1517+ -- there would be the possibility of a race in the test case should we attempt
1518+ -- to evaluate `whereis regName` on node2 right away. In case the name is still
1519+ -- erroneously registered, observing the 20 second delay (or lack of), could at
1520+ -- least give a hint that something is wrong, and we give up our time slice
1521+ -- so that there's a higher change the registrations have been cleaned up
1522+ -- in either case.
1523+ runProcess node2 $ delayUntilMaybeUnregistered nid pid
1524+
1525+ regHere <- newEmptyMVar
1526+ runProcess node2 $ whereis regName >>= liftIO . putMVar regHere
1527+ res <- takeMVar regHere
1528+ assertBool "expected Nothing, but process still registered" (res == Nothing)
1529+
1530+ where
1531+ runUntilRegistered nid us = do
1532+ whereisRemoteAsync nid regName
1533+ receiveWait [
1534+ matchIf (\(WhereIsReply n (Just p)) -> n == regName && p == us)
1535+ (const $ return ())
1536+ ]
1537+
1538+ delayUntilMaybeUnregistered nid p = do
1539+ whereisRemoteAsync nid regName
1540+ receiveTimeout 20000000 {- 20 sec delay -} [
1541+ matchIf (\(WhereIsReply n p) -> n == regName && p == Nothing)
1542+ (const $ return ())
1543+ ]
1544+ return ()
1545+
1546+ regName = "testRegisterRemote"
1547+
13721548testUnsafeSend :: TestTransport -> Assertion
13731549testUnsafeSend TestTransport{..} = do
13741550 serverAddr <- newEmptyMVar
@@ -1384,8 +1560,7 @@ testUnsafeSend TestTransport{..} = do
13841560 void $ forkProcess localNode $ do
13851561 serverPid <- liftIO $ takeMVar serverAddr
13861562 getSelfPid >>= unsafeSend serverPid
1387− () <- expect
1388− liftIO $ putMVar clientDone ()
1563+ expect >>= liftIO . putMVar clientDone
13891564
13901565 takeMVar clientDone
13911566
@@ -1404,8 +1579,7 @@ testUnsafeUSend TestTransport{..} = do
14041579 void $ forkProcess localNode $ do
14051580 serverPid <- liftIO $ takeMVar serverAddr
14061581 getSelfPid >>= unsafeUSend serverPid
1407− () <- expect
1408− liftIO $ putMVar clientDone ()
1582+ expect >>= liftIO . putMVar clientDone
14091583
14101584 takeMVar clientDone
14111585
@@ -1416,8 +1590,7 @@ testUnsafeNSend TestTransport{..} = do
14161590 localNode <- newLocalNode testTransport initRemoteTable
14171591
14181592 pid <- forkProcess localNode $ do
1419− () <- expect
1420− liftIO $ putMVar clientDone ()
1593+ expect >>= liftIO . putMVar clientDone
14211594
14221595 void $ runProcess localNode $ do
14231596 register "foobar" pid
@@ -1435,8 +1608,7 @@ testUnsafeNSendRemote TestTransport{..} = do
14351608 _ <- forkProcess localNode1 $ do
14361609 getSelfPid >>= register "foobar"
14371610 liftIO $ putMVar clientDone ()
1438− () <- expect
1439− liftIO $ putMVar clientDone ()
1611+ expect >>= liftIO . putMVar clientDone
14401612
14411613 takeMVar clientDone
14421614 void $ runProcess localNode2 $ do
@@ -1460,7 +1632,7 @@ testUnsafeSendChan TestTransport{..} = do
14601632 serverPid <- liftIO $ takeMVar serverAddr
14611633 (sp, rp) <- newChan
14621634 unsafeSend serverPid sp
1463− () <- receiveChan rp
1635+ receiveChan rp :: Process ()
14641636 liftIO $ putMVar clientDone ()
14651637
14661638 takeMVar clientDone
@@ -1474,8 +1646,8 @@ testCallLocal TestTransport{..} = do
14741646 runProcess node $ do
14751647 r <- (/=) <$> getSelfPid <*> callLocal getSelfPid
14761648 liftIO $ putMVar result r
1477− True <- takeMVar result
1478− return ()
1649+
1650+ takeMVar result >>= assertBool "Expected 'True'"
14791651
14801652 -- Testing that when callLocal is interrupted, the worker is interrupted.
14811653 ibox <- newIORef False
@@ -1492,10 +1664,9 @@ testCallLocal TestTransport{..} = do
14921664 (send keeper ())
14931665 caller <- expect
14941666 exit caller "test"
1495− () <- expect
1496− return ()
1497− True <- readIORef ibox
1498− return ()
1667+ expect :: Process ()
1668+
1669+ readIORef ibox >>= assertBool "Expected 'True'"
14991670
15001671 -- Testing that when the worker raises an exception, the exception is propagated to the parent.
15011672 ibox2 <- newIORef False
@@ -1504,8 +1675,8 @@ testCallLocal TestTransport{..} = do
15041675 liftIO $ writeIORef ibox2 $ case r of
15051676 Left (ErrorCall "e") -> True
15061677 _ -> False
1507− True <- readIORef ibox
1508− return ()
1678+
1679+ readIORef ibox >>= assertBool "Expected 'True'"
15091680
15101681 -- Test that caller waits for the worker in correct situation
15111682 ibox3 <- newIORef False
@@ -1522,8 +1693,8 @@ testCallLocal TestTransport{..} = do
15221693 liftIO $ putMVar result3 =<< readIORef ibox3
15231694 worker <- expect
15241695 send worker ()
1525− True <- takeMVar result3
1526− return ()
1696+
1697+ takeMVar result3 >>= assertBool "Expected 'True'"
15271698
15281699 -- Test that caller waits for the worker in case when caller gets an exception
15291700 ibox4 <- newIORef False
@@ -1539,13 +1710,9 @@ testCallLocal TestTransport{..} = do
15391710 `finally` (liftIO $ putMVar result4 =<< readIORef ibox4)
15401711 caller <- expect
15411712 exit caller "hi!"
1542− True <- takeMVar result4
1543− return ()
1544− -- XXX: Testing that when mask_ $ callLocal p runs p in masked state.
1545−
1546−
1547−
15481713
1714+ takeMVar result4 >>= assertBool "Expected 'True'"
1715+ -- XXX: Testing that when mask_ $ callLocal p runs p in masked state.
15491716
15501717tests :: TestTransport -> IO [Test]
15511718tests testtrans = return [
@@ -1579,6 +1746,7 @@ tests testtrans = return [
15791746 , testCase "MaskRestoreScope" (testMaskRestoreScope testtrans)
15801747 , testCase "ExitLocal" (testExitLocal testtrans)
15811748 , testCase "ExitRemote" (testExitRemote testtrans)
1749+ , testCase "RegistryMonitoring" (testRegistryMonitoring testtrans)
15821750 , testCase "TextCallLocal" (testCallLocal testtrans)
15831751 -- Unsafe Primitives
15841752 , testCase "TestUnsafeSend" (testUnsafeSend testtrans)
@@ -1631,17 +1799,3 @@ tests testtrans = return [
16311799 , testCase "MonitorUnreachable" (testMonitorUnreachable testtrans True False)
16321800 ]
16331801 ]
1634−
1635−syncBreakConnection :: (NT.EndPointAddress -> NT.EndPointAddress -> IO ()) -> LocalNode -> LocalNode -> IO ()
1636−syncBreakConnection breakConnection nid0 nid1 = do
1637− m <- newEmptyMVar
1638− _ <- forkProcess nid1 $ getSelfPid >>= liftIO . putMVar m
1639− runProcess nid0 $ do
1640− them <- liftIO $ takeMVar m
1641− pinger <- spawnLocal $ forever $ send them ()
1642− _ <- monitorNode (localNodeId nid1)
1643− liftIO $ breakConnection (nodeAddress $ localNodeId nid0)
1644− (nodeAddress $ localNodeId nid1)
1645− NodeMonitorNotification _ _ _ <- expect
1646− kill pinger "finished"
1647− return ()