Fix tests.

According to semantics network failures is guaranteed to be
noticed by network-transport iff communication happened after
connection failure. Tests were adjusted to appreciate such
semantics.

Author: qnikst

src/Control/Distributed/Process/Tests/CH.hs

@@ -302,19 +302,25 @@ testMonitorRemoteDeadProcess TestTransport{..} mOrL un = do
 testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
 testMonitorDisconnect TestTransport{..} mOrL un = do
   processAddr <- newEmptyMVar
+  processAddr2 <- newEmptyMVar
   monitorSetup <- newEmptyMVar
   done <- newEmptyMVar
 
   forkIO $ do
     localNode <- newLocalNode testTransport initRemoteTable
     addr <- forkProcess localNode . liftIO $ threadDelay 1000000
+    addr2 <- forkProcess localNode $ return ()
     putMVar processAddr addr
     readMVar monitorSetup
     NT.closeEndPoint (localEndPoint localNode)
+    putMVar processAddr2 addr2
 
   forkIO $ do
     localNode <- newLocalNode testTransport initRemoteTable
     theirAddr <- readMVar processAddr
+    forkProcess localNode $ do
+      lc <- liftIO $ readMVar processAddr2
+      send lc ()
     runProcess localNode $ do
       monitorTestProcess theirAddr mOrL un DiedDisconnect (Just monitorSetup) done
 
@@ -583,17 +589,22 @@ testMonitorLiveNode :: TestTransport -> Assertion
 testMonitorLiveNode TestTransport{..} = do
   [node1, node2] <- replicateM 2 $ newLocalNode testTransport initRemoteTable
   ready <- newEmptyMVar
+  readyr <- newEmptyMVar
   done <- newEmptyMVar
 
+  p <- forkProcess node1 $ return ()
   forkProcess node2 $ do
     ref <- monitorNode (localNodeId node1)
     liftIO $ putMVar ready ()
+    liftIO $ takeMVar readyr
+    send p ()
     NodeMonitorNotification ref' nid _ <- expect
     True <- return $ ref == ref' && nid == localNodeId node1
     liftIO $ putMVar done ()
 
   takeMVar ready
   closeLocalNode node1
+  putMVar readyr ()
 
   takeMVar done
 
@@ -734,7 +745,8 @@ testReconnect TestTransport{..} = do
 
 
     -- Simulate network failure
-    liftIO $ testBreakConnection (nodeAddress nid1) (nodeAddress nid2)
+    liftIO $ do testBreakConnection (nodeAddress nid1) (nodeAddress nid2)
+                threadDelay 1000000
 
     -- This will happen due to implicit reconnect
     registerRemoteAsync nid1 "b" us