@@ -349,6 +349,30 @@ testCloseReopen transport numPings = do
349349
350350 takeMVar doneB
351351
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
357+
358+ Right endpoint <- newEndPoint transport
359+
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]
365+ close conn
366+
367+ forkIO $ do
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)
372+ putMVar done ()
373+
374+ takeMVar done
375+
352376runTestIO :: String -> IO () -> IO ()
353377runTestIO description test = do
354378 putStr $ "Running " ++ show description ++ ": "
@@ -373,3 +397,4 @@ testTransport transport = flip runReaderT (transport, 10000) $ do
373397 runTest "CloseOneConnection" testCloseOneConnection
374398 runTest "CloseOneDirection" testCloseOneDirection
375399 runTest "CloseReopen" testCloseReopen
400+ runTest "ParallelConnects" testParallelConnects