b886c33 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Weaken testKill to send kill during send only

b886c33Edsko de Vries14 years ago

network-transport/tests/TestTCP.hs+2

compare with master

unifiedsplit

@@ -772,7 +772,9 @@ main = do

772 , ("UnidirectionalError", testUnidirectionalError nextPort)

773 , ("InvalidCloseConnection", testInvalidCloseConnection nextPort)

774 ]

775+ -- Run the generic tests even if the TCP specific tests failed..

775 testTransport (either (Left . show) (Right) <$> nextPort >>= createTransport "127.0.0.1")

776 testTransport (either (Left . show) (Right) <$> nextPort >>= createTransport "127.0.0.1")

777+ -- ..but if the generic tests pass, still fail if the specific tests did

776 case tcpResult of

778 case tcpResult of

777 Left err -> throwIO err

779 Left err -> throwIO err

778 Right () -> return ()

780 Right () -> return ()

network-transport/tests/TestTransport.hs+22−28

@@ -6,7 +6,7 @@ import TestAuxiliary (forkTry, runTests, trySome, randomThreadDelay)

6import Control.Concurrent (forkIO, killThread, yield)

7import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, readMVar, tryTakeMVar)

8import 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)

10import Control.Monad.Error ()

11import Network.Transport

12import Network.Transport.Internal (tlog)

@@ -17,7 +17,6 @@ import Data.ByteString.Char8 (pack)

17import Data.Map (Map)

18import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)

19import Data.String (fromString)

20−import Data.Maybe (catMaybes)

21import Data.List (permutations)

20import Data.List (permutations)

22import Traced

21import Traced

@@ -816,44 +815,39 @@ testSendException newTransport = do

816-- should not affect other threads.

815-- should not affect other threads.

817--

816--

818-- The intention of this test is to see what happens when a asynchronous

817-- 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

818+-- exception happes _while executing a send_. This is exceedingly difficult to

820−-- exceedingly difficult to guarantee, however. Hence we run a large number of

819+-- guarantee, however. Hence we run a large number of tests and insert random

821−-- tests and insert random thread delays -- and even then it might not happen.

820+-- thread delays -- and even then it might not happen. Moreover, it will only

822−-- Moreover, it will only happen when we run on multiple cores.

821+-- happen when we run on multiple cores.

823testKill :: IO (Either String Transport) -> Int -> IO ()

822testKill :: IO (Either String Transport) -> Int -> IO ()

824testKill newTransport numThreads = do

823testKill newTransport numThreads = do

825 Right transport1 <- newTransport

824 Right transport1 <- newTransport

826 Right transport2 <- newTransport

825 Right transport2 <- newTransport

827 Right endpoint1 <- newEndPoint transport1

826 Right endpoint1 <- newEndPoint transport1

828 Right endpoint2 <- newEndPoint transport2

827 Right endpoint2 <- newEndPoint transport2

828+

829+ Right conn <- connect endpoint1 (address endpoint2) ReliableOrdered defaultConnectHints

830+ ConnectionOpened _ _ _ <- receive endpoint2

829

831

830− threads <- forM [1 .. numThreads] $ \_ -> do

832+ threads <- replicateM numThreads . forkIO $ do

831− done <- newEmptyMVar

832− tid <- forkIO $ do

833− randomThreadDelay 10

834− Right conn <- connect endpoint1 (address endpoint2) ReliableOrdered defaultConnectHints

835− randomThreadDelay 10

833+ randomThreadDelay 10

836− Right () <- send conn ["ping"]

834+ Right () <- send conn ["ping"]

837− randomThreadDelay 10

838− close conn

839− putMVar done ()

840−

841− return (tid, done)

835+ return ()

842

836

843 -- Kill half of those threads, and wait on the rest

837 -- Kill half of those threads, and wait on the rest

844 killerDone <- newEmptyMVar

838 killerDone <- newEmptyMVar

845 forkIO $ do

839 forkIO $ do

846− wait <- forM threads $ \(tid, done) -> do

840+ killed <- forM threads $ \tid -> do

847 shouldKill <- randomIO

841 shouldKill <- randomIO

848− if shouldKill

849− then do

850− randomThreadDelay 30

842+ when shouldKill $ randomThreadDelay 10 >> killThread tid

851− killThread tid

852− return Nothing

843+ return shouldKill

853− else

844+

854− return (Just done)

845+ -- We should receive at least the pings from the threads that we didn't

855−

846+ -- kill (we might get more, depending on when exactly the kill happens)

856− mapM_ takeMVar (catMaybes wait)

847+ forM_ killed $ \wasKilled -> unless wasKilled $ do

848+ Received _ ["ping"] <- receive endpoint2

849+ return ()

850+

857 putMVar killerDone ()

851 putMVar killerDone ()

858

852

859 takeMVar killerDone

853 takeMVar killerDone