git.iko.soy/distributed-process
on master help sign in
Fix testUnnecessaryConnect
commitb231245d57d1a2c25237075b3c9c5f5f224ed564 authorEdsko de Vries <edsko@edsko.net> dateFri 18 May 2012, 11:51 (14 years ago) parent7bab424
4 files changed+33−20
compare with master
unifiedsplit
network-transport/src/Network/Transport/TCP.hs+4−3 network-transport/tests/TestAuxiliary.hs+1−1 network-transport/tests/TestTCP.hs+27−2 network-transport/tests/TestTransport.hs+1−14
network-transport/src/Network/Transport/TCP.hs+4−3
@@ -872,9 +872,10 @@ handleConnectionRequest transport sock = handle tryCloseSocket $ do
872872 , sendOn = sendMany sock
873873 }
874874 sendMany sock [encodeInt32 ConnectionRequestAccepted]
875− -- TODO: this putMVar might block if the remote endpoint sends a
876− -- connection request for a local endpoint that it is already
877− -- connected to
875+ -- If the remote endpoint (due to a bug) attempts to connect the
876+ -- same local endpoint twice, the sceond attempt wil have been
877+ -- rejected with ConnectionRequestCrossed and so will never get to
878+ -- this point
878879 putMVar (remoteState theirEndPoint) (RemoteEndPointValid vst)
879880 return (Just theirEndPoint)
880881 -- If we left the scope of the exception handler with a return value of
network-transport/tests/TestAuxiliary.hs+1−1
@@ -32,7 +32,7 @@ runTest :: String -> IO () -> IO Bool
3232runTest description test = do
3333 putStr $ "Running " ++ show description ++ ": "
3434 hFlush stdout
35− done <- try . timeout 20000000 $ test
35+ done <- try . timeout 20000000 $ test -- 20 seconds
3636 case done of
3737 Left err -> failed $ "(exception: " ++ show (err :: SomeException) ++ ")"
3838 Right Nothing -> failed $ "(timeout)"
network-transport/tests/TestTCP.hs+27−2
@@ -10,7 +10,7 @@ import Network.Transport.TCP (createTransport, encodeEndPointAddress)
1010import Data.Int (Int32)
1111import Control.Concurrent (threadDelay)
1212import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar)
13−import Control.Monad (replicateM, guard, forM_)
13+import Control.Monad (replicateM, guard, forM_, replicateM_)
1414import Control.Applicative ((<$>))
1515import Control.Exception (throw)
1616import Network.Transport.TCP ( ControlHeader(..)
@@ -27,6 +27,8 @@ import qualified Network.Socket as N ( sClose
2727import Network.Socket.ByteString (sendMany)
2828import Data.String (fromString)
2929import Traced
30+import GHC.IO.Exception (ioe_errno)
31+import Foreign.C.Error (Errno(..), eADDRNOTAVAIL)
3032
3133instance Traceable ControlHeader where
3234 trace = traceShow
@@ -465,11 +467,33 @@ testUnnecessaryConnect nextPort = do
465467 forkTry $ do
466468 let ourAddress = EndPointAddress "ourAddress"
467469 Right (_, ConnectionRequestAccepted) <- readMVar serverAddr >>= socketToEndPoint ourAddress
468− Right (_, ConnectionRequestEndPointInvalid) <- readMVar serverAddr >>= socketToEndPoint ourAddress
470+ Right (_, ConnectionRequestCrossed) <- readMVar serverAddr >>= socketToEndPoint ourAddress
469471 putMVar clientDone ()
470472
471473 takeMVar clientDone
472474
475+-- | Test that we can create "many" transport instances
476+testMany :: IO N.ServiceName -> IO ()
477+testMany nextPort = do
478+ Right masterTransport <- nextPort >>= createTransport "127.0.0.1"
479+ Right masterEndPoint <- newEndPoint masterTransport
480+
481+ replicateM_ 20 $ do
482+ mTransport <- nextPort >>= createTransport "127.0.0.1"
483+ threadDelay 2000000
484+ case mTransport of
485+ Left ex -> do
486+ putStrLn $ "IOException: " ++ show ex ++ "; errno = " ++ show (ioe_errno ex)
487+ case (ioe_errno ex) of
488+ Just no | Errno no == eADDRNOTAVAIL -> putStrLn "(ADDRNOTAVAIL)"
489+ _ -> return ()
490+ throw ex
491+ Right transport ->
492+ replicateM_ 3 $ do
493+ Right endpoint <- newEndPoint transport
494+ Right _ <- connect endpoint (address masterEndPoint) ReliableOrdered defaultConnectHints
495+ return ()
496+
473497main :: IO ()
474498main = do
475499 portMVar <- newEmptyMVar
@@ -483,5 +507,6 @@ main = do
483507 , ("TestUnnecessaryConnect", testUnnecessaryConnect nextPort)
484508 , ("InvalidAddress", testInvalidAddress nextPort)
485509 , ("InvalidConnect", testInvalidConnect nextPort)
510+ , ("TestMany", testMany nextPort)
486511 ]
487512 testTransport (either (Left . show) (Right) <$> nextPort >>= createTransport "127.0.0.1")
network-transport/tests/TestTransport.hs+1−14
@@ -703,25 +703,12 @@ testCloseTransport newTransport = do
703703
704704 mapM_ takeMVar [serverDone, clientDone]
705705
706−testMany :: IO (Either String Transport) -> IO ()
707−testMany newTransport = do
708− Right masterTransport <- newTransport
709− Right masterEndPoint <- newEndPoint masterTransport
710−
711− replicateM_ 20 $ do
712− Right transport <- newTransport
713− replicateM_ 2 $ do
714− Right endpoint <- newEndPoint transport
715− Right _ <- connect endpoint (address masterEndPoint) ReliableOrdered
716− return ()
717−
718706-- Transport tests
719707testTransport :: IO (Either String Transport) -> IO ()
720708testTransport newTransport = do
721709 Right transport <- newTransport
722710 runTests
723− [ ("Many", testMany newTransport)
724− , ("PingPong", testPingPong transport numPings)
711+ [ ("PingPong", testPingPong transport numPings)
725712 , ("EndPoints", testEndPoints transport numPings)
726713 , ("Connections", testConnections transport numPings)
727714 , ("CloseOneConnection", testCloseOneConnection transport numPings)