b98e6ec · distributed-process

distributed-process-tests/distributed-process-tests.cabal+3−2

compare with master

unifiedsplit

@@ -31,6 +31,7 @@ library

31 bytestring >= 0.9 && < 0.12,

32 distributed-process >= 0.6.0 && < 0.8,

33 distributed-static,

34+ exceptions >= 0.5,

34 HUnit >= 1.2 && < 1.7,

35 HUnit >= 1.2 && < 1.7,

35 network-transport >= 0.4.1.0 && < 0.6,

36 network-transport >= 0.4.1.0 && < 0.6,

36 network >= 2.5 && < 2.7,

37 network >= 2.5 && < 2.7,

@@ -126,7 +127,7 @@ Test-Suite TestMx

126 network-transport-inmemory >= 0.5,

127 network-transport-inmemory >= 0.5,

127 test-framework >= 0.6 && < 0.9

128 test-framework >= 0.6 && < 0.9

128 Extensions: CPP

129 Extensions: CPP

129− ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

130+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

130 HS-Source-Dirs: tests

131 HS-Source-Dirs: tests

131

132

132Test-Suite TestTracing

133Test-Suite TestTracing

@@ -140,5 +141,5 @@ Test-Suite TestTracing

140 network-transport-inmemory >= 0.5,

141 network-transport-inmemory >= 0.5,

141 test-framework >= 0.6 && < 0.9

142 test-framework >= 0.6 && < 0.9

142 Extensions: CPP

143 Extensions: CPP

143− ghc-options: -Wall -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

144+ ghc-options: -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

144 HS-Source-Dirs: tests

145 HS-Source-Dirs: tests

distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+13−8

@@ -25,13 +25,18 @@ import Control.Concurrent.MVar

25 )

26import Control.Monad (replicateM_, replicateM, forever, void, unless, join)

27import Control.Exception (SomeException, throwIO, ErrorCall(..))

28−import qualified Control.Exception as Ex (catch)

28+import Control.Monad.Catch (try, catch, finally, mask, onException)

29−import Control.Applicative ((<$>), (<*>), pure, (<|>))

29+import Control.Applicative ((<|>))

30import qualified Network.Transport as NT (closeEndPoint, EndPointAddress)

31−import Control.Distributed.Process

31+import Control.Distributed.Process hiding

32+ ( try

33+ , catch

34+ , finally

35+ , mask

36+ , onException

37+ )

32import Control.Distributed.Process.Internal.Types

38import Control.Distributed.Process.Internal.Types

33− ( NodeId(nodeAddress)

34− , LocalNode(localEndPoint)

39+ ( LocalNode(localEndPoint)

35 , ProcessExitException(..)

40 , ProcessExitException(..)

36 , nullProcessId

41 , nullProcessId

37 , createUnencodedMessage

42 , createUnencodedMessage

@@ -65,7 +70,7 @@ expectThat a matcher = case res of

65forkTry :: IO () -> IO ThreadId

70forkTry :: IO () -> IO ThreadId

66forkTry p = do

71forkTry p = do

67 tid <- myThreadId

72 tid <- myThreadId

68− forkIO $ Ex.catch p (\e -> throwTo tid (e :: SomeException))

73+ forkIO $ catch p (\e -> throwTo tid (e :: SomeException))

69

74

70-- | The ping server from the paper

75-- | The ping server from the paper

71ping :: Process ()

76ping :: Process ()

@@ -700,8 +705,8 @@ testRemoteRegistry TestTransport{..} = do

700 (\(RegisterReply _ _ _) -> return ()) ]

705 (\(RegisterReply _ _ _) -> return ()) ]

701 registerRemoteAsync nid1 "ping" deadProcess

706 registerRemoteAsync nid1 "ping" deadProcess

702 receiveWait [

707 receiveWait [

703− matchIf (\(RegisterReply label' False (Just pid)) ->

708+ matchIf (\(RegisterReply label' False (Just pid'')) ->

704− "ping" == label' && pid == pingServer)

709+ "ping" == label' && pid'' == pingServer)

705 (\(RegisterReply _ _ _) -> return ()) ]

710 (\(RegisterReply _ _ _) -> return ()) ]

706 unregisterRemoteAsync nid1 "dead"

711 unregisterRemoteAsync nid1 "dead"

707 receiveWait [

712 receiveWait [

distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs+1−1

@@ -486,7 +486,7 @@ testSpawnReconnect :: TestTransport -> RemoteTable -> Assertion

486testSpawnReconnect testtrans@TestTransport{..} rtable = do

487 [node1, node2] <- replicateM 2 $ newLocalNode testTransport rtable

488 let nid1 = localNodeId node1

489− nid2 = localNodeId node2

489+ -- nid2 = localNodeId node2

490 done <- newEmptyMVar

491 iv <- newMVar (0 :: Int)

492

distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs−2

@@ -4,7 +4,6 @@ module Control.Distributed.Process.Tests.Mx (tests) where

4import Control.Distributed.Process.Tests.Internal.Utils

5import Network.Transport.Test (TestTransport(..))

6

7−import Control.Concurrent (threadDelay)

8import Control.Distributed.Process

7import Control.Distributed.Process

9import Control.Distributed.Process.Node

8import Control.Distributed.Process.Node

10import Control.Distributed.Process.Management

9import Control.Distributed.Process.Management

@@ -21,7 +20,6 @@ import Control.Distributed.Process.Management

21 , mxUpdateLocal

20 , mxUpdateLocal

22 , mxNotify

21 , mxNotify

23 , mxBroadcast

22 , mxBroadcast

24− , mxGetId

25 )

23 )

26import Control.Monad (void)

24import Control.Monad (void)

27import Data.Binary

25import Data.Binary

distributed-process-tests/src/Control/Distributed/Process/Tests/Receive.hs+7−8

@@ -10,13 +10,12 @@ import Network.Transport.Test (TestTransport(..))

10

11import Network.Transport (Transport)

12import Control.Distributed.Process

13−import Control.Distributed.Process.Closure

14import Control.Distributed.Process.Node

13import Control.Distributed.Process.Node

15

14

16import Control.Monad

15import Control.Monad

17

16

18import Test.HUnit (Assertion, (@?=))

17import Test.HUnit (Assertion, (@?=))

19−import Test.Framework (Test, defaultMain)

18+import Test.Framework (Test)

20import Test.Framework.Providers.HUnit (testCase)

19import Test.Framework.Providers.HUnit (testCase)

21

20

22-- Tests:

21-- Tests:

@@ -43,7 +42,7 @@ recTest2 :: ReceivePort ()

43 -> SendPort String

42 -> SendPort String

44 -> ReceivePort String -> ReceivePort String

43 -> ReceivePort String -> ReceivePort String

45 -> Process ()

44 -> Process ()

46−recTest2 wait sync r1 r2 = do

45+recTest2 wait sync r1 _ = do

47 forever $ do

46 forever $ do

48 receiveChan wait

47 receiveChan wait

49 r <- receiveWait

48 r <- receiveWait

@@ -56,7 +55,7 @@ recTest3 :: ReceivePort ()

56 -> SendPort String

55 -> SendPort String

57 -> ReceivePort String -> ReceivePort String

56 -> ReceivePort String -> ReceivePort String

58 -> Process ()

57 -> Process ()

59−recTest3 wait sync r1 r2 = do

58+recTest3 wait sync r1 _ = do

60 forever $ do

59 forever $ do

61 receiveChan wait

60 receiveChan wait

62 r <- receiveWait

61 r <- receiveWait

@@ -69,7 +68,7 @@ recTest4 :: ReceivePort ()

69 -> SendPort String

68 -> SendPort String

70 -> ReceivePort String -> ReceivePort String

69 -> ReceivePort String -> ReceivePort String

71 -> Process ()

70 -> Process ()

72−recTest4 wait sync r1 r2 = do

71+recTest4 wait sync r1 _ = do

73 forever $ do

72 forever $ do

74 receiveChan wait

73 receiveChan wait

75 r <- receiveWait

74 r <- receiveWait

@@ -83,11 +82,11 @@ master :: Process ()

83master = do

82master = do

84 (waits,waitr) <- newChan

83 (waits,waitr) <- newChan

85 (syncs,syncr) <- newChan

84 (syncs,syncr) <- newChan

86− let go expect = do

85+ let go expected = do

87 sendChan waits ()

86 sendChan waits ()

88 r <- receiveChan syncr

87 r <- receiveChan syncr

89− liftIO $ print (r,expect, r == expect)

88+ liftIO $ print (r, expected, r == expected)

90− liftIO $ r @?= expect

89+ liftIO $ r @?= expected

91

90

92 liftIO $ putStrLn "---- Test 1 ----"

91 liftIO $ putStrLn "---- Test 1 ----"

93 (s1,r1) <- newChan

92 (s1,r1) <- newChan