network-transport-tests 0.2.3.0 → 0.2.4.1
raw patch · 2 files changed
+89/−17 lines, 2 filesdep ~network-transportPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: network-transport
API changes (from Hackage documentation)
Files
network-transport-tests.cabal view
@@ -1,5 +1,5 @@ name: network-transport-tests-version: 0.2.3.0+version: 0.2.4.1 synopsis: Unit tests for Network.Transport implementations -- description: homepage: http://haskell-distributed.github.com@@ -23,7 +23,7 @@ Network.Transport.Tests.Traced -- other-modules: build-depends: base >= 4.5 && < 5,- network-transport >= 0.4.1.0 && < 0.5,+ network-transport >= 0.4.1.0 && < 0.6, containers >= 0.4 && < 0.6, bytestring >= 0.9 && < 0.11, random >= 1.0 && < 1.2,
src/Network/Transport/Tests.hs view
@@ -407,11 +407,18 @@ Right conn <- connect endpoint (address endpoint) ReliableOrdered defaultConnectHints + -- Must clear the ConnectionOpened event or else sending may block+ ConnectionOpened _ _ _ <- receive endpoint+ do send conn [ error "bang!" ] error "testSelfSend: send didn't fail" `catch` (\(ErrorCall "bang!") -> return ()) close conn++ -- Must clear this event or else closing the end point may block.+ ConnectionClosed _ <- receive endpoint+ closeEndPoint endpoint -- | Test that sending on a closed connection gives an error@@ -487,6 +494,7 @@ testConnectToSelf :: Transport -> Int -> IO () testConnectToSelf transport numPings = do done <- newEmptyMVar+ reconnect <- newEmptyMVar Right endpoint <- newEndPoint transport tlog "Creating self-connection"@@ -503,13 +511,17 @@ tlog $ "Closing connection" close conn+ readMVar reconnect+ ConnectionOpened cid' _ _ <- receive endpoint+ ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid' == cid''+ return () -- And one thread to read forkTry $ do tlog $ "reading" tlog "Waiting for ConnectionOpened"- ConnectionOpened cid _ addr <- receive endpoint ; True <- return $ addr == address endpoint+ ConnectionOpened cid _ addr <- receive endpoint tlog "Waiting for Received" replicateM_ numPings $ do@@ -519,6 +531,13 @@ tlog "Waiting for ConnectionClosed" ConnectionClosed cid' <- receive endpoint ; True <- return $ cid == cid' + putMVar reconnect ()++ -- Check that the addr supplied also connects to self.+ -- The other thread verifies this.+ Right conn <- connect endpoint addr ReliableOrdered defaultConnectHints+ close conn+ tlog "Done" putMVar done () @@ -530,14 +549,19 @@ done <- newEmptyMVar Right endpoint <- newEndPoint transport - tlog "Creating self-connection"- Right conn1 <- connect endpoint (address endpoint) ReliableOrdered defaultConnectHints- Right conn2 <- connect endpoint (address endpoint) ReliableOrdered defaultConnectHints- tlog "Talk to myself" + -- An MVar to ensure that the node which sends pingA will connect first, as+ -- this determines the order of the events given out by 'collect' and is+ -- essential for the equality test there.+ firstConnectionMade <- newEmptyMVar+ -- One thread to write to the endpoint using the first connection forkTry $ do+ tlog "Creating self-connection"+ Right conn1 <- connect endpoint (address endpoint) ReliableOrdered defaultConnectHints+ putMVar firstConnectionMade ()+ tlog $ "writing" tlog $ "Sending ping"@@ -548,6 +572,9 @@ -- One thread to write to the endpoint using the second connection forkTry $ do+ takeMVar firstConnectionMade+ tlog "Creating self-connection"+ Right conn2 <- connect endpoint (address endpoint) ReliableOrdered defaultConnectHints tlog $ "writing" tlog $ "Sending ping"@@ -577,20 +604,26 @@ Right endpoint1 <- newEndPoint transport Right endpoint2 <- newEndPoint transport Right conn1 <- connect endpoint1 (address endpoint1) ReliableOrdered defaultConnectHints+ ConnectionOpened _ _ _ <- receive endpoint1 Right conn2 <- connect endpoint1 (address endpoint1) ReliableOrdered defaultConnectHints+ ConnectionOpened _ _ _ <- receive endpoint1 Right conn3 <- connect endpoint2 (address endpoint2) ReliableOrdered defaultConnectHints+ ConnectionOpened _ _ _ <- receive endpoint2 -- Close the conneciton and try to send close conn1+ ConnectionClosed _ <- receive endpoint1 Left (TransportError SendClosed _) <- send conn1 ["ping"] -- Close the first endpoint. We should not be able to use the first -- connection anymore, or open more self connections, but the self connection -- to the second endpoint should still be fine closeEndPoint endpoint1+ EndPointClosed <- receive endpoint1 Left (TransportError SendFailed _) <- send conn2 ["ping"] Left (TransportError ConnectFailed _) <- connect endpoint1 (address endpoint1) ReliableOrdered defaultConnectHints Right () <- send conn3 ["ping"]+ Received _ _ <- receive endpoint2 -- Close the transport; now the second should no longer work closeTransport transport@@ -607,6 +640,7 @@ -- | Test various aspects of 'closeEndPoint' testCloseEndPoint :: Transport -> Int -> IO () testCloseEndPoint transport _ = do+ serverFirstTestDone <- newEmptyMVar serverDone <- newEmptyMVar clientDone <- newEmptyMVar clientAddr1 <- newEmptyMVar@@ -621,15 +655,23 @@ -- First test (see client) do theirAddr <- readMVar clientAddr1- ConnectionOpened cid ReliableOrdered addr <- receive endpoint ; True <- return $ addr == theirAddr+ ConnectionOpened cid ReliableOrdered addr <- receive endpoint+ -- Ensure that connecting to the supplied address reaches the peer.+ Right conn <- connect endpoint addr ReliableOrdered defaultConnectHints+ close conn+ putMVar serverFirstTestDone () ConnectionClosed cid' <- receive endpoint ; True <- return $ cid == cid'+ putMVar serverAddr (address endpoint) return () -- Second test do theirAddr <- readMVar clientAddr2 - ConnectionOpened cid ReliableOrdered addr <- receive endpoint ; True <- return $ addr == theirAddr+ ConnectionOpened cid ReliableOrdered addr <- receive endpoint+ -- Ensure that connecting to the supplied address reaches the peer.+ Right conn <- connect endpoint addr ReliableOrdered defaultConnectHints+ close conn Received cid' ["ping"] <- receive endpoint ; True <- return $ cid == cid' Right conn <- connect endpoint theirAddr ReliableOrdered defaultConnectHints@@ -646,29 +688,37 @@ -- Client forkTry $ do- theirAddr <- readMVar serverAddr -- First test: close endpoint with one outgoing but no incoming connections do+ theirAddr <- takeMVar serverAddr Right endpoint <- newEndPoint transport putMVar clientAddr1 (address endpoint) -- Connect to the server, then close the endpoint without disconnecting explicitly Right _ <- connect endpoint theirAddr ReliableOrdered defaultConnectHints+ ConnectionOpened cid _ _ <- receive endpoint+ ConnectionClosed cid' <- receive endpoint ; True <- return $ cid == cid'+ -- Don't close before the remote server had a chance to digest the+ -- connection.+ readMVar serverFirstTestDone closeEndPoint endpoint EndPointClosed <- receive endpoint return () -- Second test: close endpoint with one outgoing and one incoming connection do+ theirAddr <- takeMVar serverAddr Right endpoint <- newEndPoint transport putMVar clientAddr2 (address endpoint) Right conn <- connect endpoint theirAddr ReliableOrdered defaultConnectHints+ ConnectionOpened cid _ _ <- receive endpoint+ ConnectionClosed cid' <- receive endpoint ; True <- return $ cid == cid' send conn ["ping"] -- Reply from the server- ConnectionOpened cid ReliableOrdered addr <- receive endpoint ; True <- return $ addr == theirAddr+ ConnectionOpened cid ReliableOrdered addr <- receive endpoint Received cid' ["pong"] <- receive endpoint ; True <- return $ cid == cid' -- Close the endpoint@@ -709,16 +759,27 @@ -- Client sets up first endpoint theirAddr1 <- readMVar clientAddr1- ConnectionOpened cid1 ReliableOrdered addr <- receive endpoint ; True <- return $ addr == theirAddr1+ ConnectionOpened cid1 ReliableOrdered addr <- receive endpoint+ -- Test that the address given does indeed point back to the client+ Right conn <- connect endpoint theirAddr1 ReliableOrdered defaultConnectHints+ close conn+ Right conn <- connect endpoint addr ReliableOrdered defaultConnectHints+ close conn -- Client sets up second endpoint theirAddr2 <- readMVar clientAddr2 - ConnectionOpened cid2 ReliableOrdered addr' <- receive endpoint ; True <- return $ addr' == theirAddr2+ ConnectionOpened cid2 ReliableOrdered addr' <- receive endpoint+ -- We're going to use addr' to connect back to the server, which tests+ -- that it's a valid address (but not *necessarily* == to theirAddr2+ Received cid2' ["ping"] <- receive endpoint ; True <- return $ cid2' == cid2 Right conn <- connect endpoint theirAddr2 ReliableOrdered defaultConnectHints send conn ["pong"]+ close conn+ Right conn <- connect endpoint addr' ReliableOrdered defaultConnectHints+ send conn ["pong"] -- Client now closes down its transport. We should receive connection closed messages (we don't know the precise order, however) -- TODO: should we get an EventConnectionLost for theirAddr1? We have no outgoing connections@@ -726,7 +787,7 @@ let expected = [ ConnectionClosed cid1 , ConnectionClosed cid2 -- , ErrorEvent (TransportError (EventConnectionLost theirAddr1) "")- , ErrorEvent (TransportError (EventConnectionLost theirAddr2) "")+ , ErrorEvent (TransportError (EventConnectionLost addr') "") ] True <- return $ expected `elem` permutations evs @@ -746,16 +807,27 @@ -- Connect to the server, then close the endpoint without disconnecting explicitly Right _ <- connect endpoint1 theirAddr ReliableOrdered defaultConnectHints+ -- Server connects back to verify that both addresses they have for us+ -- are suitable to reach us.+ ConnectionOpened cid ReliableOrdered _ <- receive endpoint1+ ConnectionClosed cid' <- receive endpoint1 ; True <- return $ cid == cid'+ ConnectionOpened cid ReliableOrdered _ <- receive endpoint1+ ConnectionClosed cid' <- receive endpoint1 ; True <- return $ cid == cid' - -- Set up an endpoint with one outgoing and out incoming connection+ -- Set up an endpoint with one outgoing and one incoming connection Right endpoint2 <- newEndPoint transport putMVar clientAddr2 (address endpoint2) + -- The outgoing connection. Right conn <- connect endpoint2 theirAddr ReliableOrdered defaultConnectHints send conn ["ping"] - -- Reply from the server- ConnectionOpened cid ReliableOrdered addr <- receive endpoint2 ; True <- return $ addr == theirAddr+ -- Reply from the server. It will connect twice, using both addresses+ -- (the one that the client sees, and the one that the server sees).+ ConnectionOpened cid ReliableOrdered _ <- receive endpoint2+ Received cid' ["pong"] <- receive endpoint2 ; True <- return $ cid == cid'+ ConnectionClosed cid'' <- receive endpoint2 ; True <- return $ cid == cid''+ ConnectionOpened cid ReliableOrdered _ <- receive endpoint2 Received cid' ["pong"] <- receive endpoint2 ; True <- return $ cid == cid' -- Now shut down the entire transport