@@ -6,7 +6,7 @@ import TestAuxiliary (forkTry, runTests, trySome, randomThreadDelay)
66import Control.Concurrent (forkIO, killThread, yield)
77import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, readMVar, tryTakeMVar)
88import Control.Exception (evaluate, throw, throwIO)
9−import Control.Monad (replicateM, replicateM_, when, guard, forM, forM_)
9+import Control.Monad (replicateM, replicateM_, when, guard, forM, forM_, unless)
1010import Control.Monad.Error ()
1111import Network.Transport
1212import Network.Transport.Internal (tlog)
@@ -17,7 +17,6 @@ import Data.ByteString.Char8 (pack)
1717import Data.Map (Map)
1818import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)
1919import Data.String (fromString)
20−import Data.Maybe (catMaybes)
2120import Data.List (permutations)
2221import Traced
2322
@@ -816,44 +815,39 @@ testSendException newTransport = do
816815-- should not affect other threads.
817816--
818817-- The intention of this test is to see what happens when a asynchronous
819−-- exception happes _while executing a send, connect, or close_. This is
820−-- exceedingly difficult to guarantee, however. Hence we run a large number of
821−-- tests and insert random thread delays -- and even then it might not happen.
822−-- Moreover, it will only happen when we run on multiple cores.
818+-- exception happes _while executing a send_. This is exceedingly difficult to
819+-- guarantee, however. Hence we run a large number of tests and insert random
820+-- thread delays -- and even then it might not happen. Moreover, it will only
821+-- happen when we run on multiple cores.
823822testKill :: IO (Either String Transport) -> Int -> IO ()
824823testKill newTransport numThreads = do
825824 Right transport1 <- newTransport
826825 Right transport2 <- newTransport
827826 Right endpoint1 <- newEndPoint transport1
828827 Right endpoint2 <- newEndPoint transport2
828+
829+ Right conn <- connect endpoint1 (address endpoint2) ReliableOrdered defaultConnectHints
830+ ConnectionOpened _ _ _ <- receive endpoint2
829831
830− threads <- forM [1 .. numThreads] $ \_ -> do
831− done <- newEmptyMVar
832− tid <- forkIO $ do
833− randomThreadDelay 10
834− Right conn <- connect endpoint1 (address endpoint2) ReliableOrdered defaultConnectHints
835− randomThreadDelay 10
836− Right () <- send conn ["ping"]
837− randomThreadDelay 10
838− close conn
839− putMVar done ()
840−
841− return (tid, done)
832+ threads <- replicateM numThreads . forkIO $ do
833+ randomThreadDelay 10
834+ Right () <- send conn ["ping"]
835+ return ()
842836
843837 -- Kill half of those threads, and wait on the rest
844838 killerDone <- newEmptyMVar
845839 forkIO $ do
846− wait <- forM threads $ \(tid, done) -> do
840+ killed <- forM threads $ \tid -> do
847841 shouldKill <- randomIO
848− if shouldKill
849− then do
850− randomThreadDelay 30
851− killThread tid
852− return Nothing
853− else
854− return (Just done)
855−
856− mapM_ takeMVar (catMaybes wait)
842+ when shouldKill $ randomThreadDelay 10 >> killThread tid
843+ return shouldKill
844+
845+ -- We should receive at least the pings from the threads that we didn't
846+ -- kill (we might get more, depending on when exactly the kill happens)
847+ forM_ killed $ \wasKilled -> unless wasKilled $ do
848+ Received _ ["ping"] <- receive endpoint2
849+ return ()
850+
857851 putMVar killerDone ()
858852
859853 takeMVar killerDone