@@ -882,8 +882,8 @@ testCrossing :: Transport -> Int -> IO ()
882testCrossing transport numRepeats = do
882testCrossing transport numRepeats = do
883 [aAddr, bAddr] <- replicateM 2 newEmptyMVar
883 [aAddr, bAddr] <- replicateM 2 newEmptyMVar
884 [aDone, bDone] <- replicateM 2 newEmptyMVar
884 [aDone, bDone] <- replicateM 2 newEmptyMVar
885+ [aGo, bGo] <- replicateM 2 newEmptyMVar
885 [aTimeout, bTimeout] <- replicateM 2 newEmptyMVar
886 [aTimeout, bTimeout] <- replicateM 2 newEmptyMVar
888 let hints = defaultConnectHints {
888 let hints = defaultConnectHints {
889 connectTimeout = Just 5000000
889 connectTimeout = Just 5000000
@@ -896,7 +896,7 @@ testCrossing transport numRepeats = do
896 theirAddress <- readMVar bAddr
896 theirAddress <- readMVar bAddr
898 replicateM_ numRepeats $ do
898 replicateM_ numRepeats $ do
899− takeMVar go >> yield
899+ takeMVar aGo >> yield
900 -- Because we are creating lots of connections, it's possible that
900 -- Because we are creating lots of connections, it's possible that
901 -- connect times out (for instance, in the TCP transport,
901 -- connect times out (for instance, in the TCP transport,
902 -- Network.Socket.connect may time out). We shouldn't regard this as an
902 -- Network.Socket.connect may time out). We shouldn't regard this as an
@@ -914,9 +914,9 @@ testCrossing transport numRepeats = do
914 Right endpoint <- newEndPoint transport
914 Right endpoint <- newEndPoint transport
915 putMVar bAddr (address endpoint)
915 putMVar bAddr (address endpoint)
916 theirAddress <- readMVar aAddr
916 theirAddress <- readMVar aAddr
918 replicateM_ numRepeats $ do
918 replicateM_ numRepeats $ do
919− takeMVar go >> yield
919+ takeMVar bGo >> yield
920 connectResult <- connect endpoint theirAddress ReliableOrdered hints
920 connectResult <- connect endpoint theirAddress ReliableOrdered hints
921 case connectResult of
921 case connectResult of
922 Right conn -> close conn
922 Right conn -> close conn
@@ -930,8 +930,10 @@ testCrossing transport numRepeats = do
930 -- putStrLn $ "Round " ++ show _i
930 -- putStrLn $ "Round " ++ show _i
931 tryTakeMVar aTimeout
931 tryTakeMVar aTimeout
932 tryTakeMVar bTimeout
932 tryTakeMVar bTimeout
933− putMVar go ()
933+ b <- randomIO
934+ if b then do putMVar aGo () ; putMVar bGo ()
934− putMVar go ()
935+ else do putMVar bGo () ; putMVar aGo ()
935 takeMVar aDone
937 takeMVar aDone
936 takeMVar bDone
938 takeMVar bDone