@@ -349,6 +349,30 @@ testCloseReopen transport numPings = do
350 takeMVar doneB
350 takeMVar doneB
352+-- Test lots of parallel connection attempts
353+testParallelConnects :: Transport -> Int -> IO ()
354+testParallelConnects transport numPings = do
355+ server <- spawn transport echoServer
356+ done <- newEmptyMVar
358+ Right endpoint <- newEndPoint transport
360+ -- Spawn lots of clients
361+ forM_ [1 .. numPings] $ \i -> forkIO $ do
362+ Right conn <- connect endpoint server ReliableOrdered
363+ send conn [pack $ "ping" ++ show i]
364+ send conn [pack $ "ping" ++ show i]
368+ eventss <- collect endpoint (numPings * 4)
369+ -- Check that no pings got sent to the wrong connection
370+ forM_ eventss $ \(_, [[ping1], [ping2]]) ->
371+ guard (ping1 == ping2)
352runTestIO :: String -> IO () -> IO ()
376runTestIO :: String -> IO () -> IO ()
353runTestIO description test = do
377runTestIO description test = do
354 putStr $ "Running " ++ show description ++ ": "
378 putStr $ "Running " ++ show description ++ ": "
@@ -373,3 +397,4 @@ testTransport transport = flip runReaderT (transport, 10000) $ do
373 runTest "CloseOneConnection" testCloseOneConnection
397 runTest "CloseOneConnection" testCloseOneConnection
374 runTest "CloseOneDirection" testCloseOneDirection
398 runTest "CloseOneDirection" testCloseOneDirection
375 runTest "CloseReopen" testCloseReopen
399 runTest "CloseReopen" testCloseReopen
400+ runTest "ParallelConnects" testParallelConnects