git.iko.soy/distributed-process
on master help sign in
Get rid of compiler warnings, especially concerning APIs we've deprecated ourselves
commitb98e6ecb24dd75780f2b3e61ac6e890c7eabcca2 authorTim Watson <watson.timothy@gmail.com> dateSun 11 Nov 2018, 22:49 (8 years ago) parent6ddda4f
5 files changed+24−21
compare with master
unifiedsplit
distributed-process-tests/distributed-process-tests.cabal+3−2 distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+13−8 distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs+1−1 distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs−2 distributed-process-tests/src/Control/Distributed/Process/Tests/Receive.hs+7−8
distributed-process-tests/distributed-process-tests.cabal+3−2
@@ -31,6 +31,7 @@ library
3131 bytestring >= 0.9 && < 0.12,
3232 distributed-process >= 0.6.0 && < 0.8,
3333 distributed-static,
34+ exceptions >= 0.5,
3435 HUnit >= 1.2 && < 1.7,
3536 network-transport >= 0.4.1.0 && < 0.6,
3637 network >= 2.5 && < 2.7,
@@ -126,7 +127,7 @@ Test-Suite TestMx
126127 network-transport-inmemory >= 0.5,
127128 test-framework >= 0.6 && < 0.9
128129 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
130131 HS-Source-Dirs: tests
131132
132133Test-Suite TestTracing
@@ -140,5 +141,5 @@ Test-Suite TestTracing
140141 network-transport-inmemory >= 0.5,
141142 test-framework >= 0.6 && < 0.9
142143 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
144145 HS-Source-Dirs: tests
distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs+13−8
@@ -25,13 +25,18 @@ import Control.Concurrent.MVar
2525 )
2626import Control.Monad (replicateM_, replicateM, forever, void, unless, join)
2727import Control.Exception (SomeException, throwIO, ErrorCall(..))
28−import qualified Control.Exception as Ex (catch)
29−import Control.Applicative ((<$>), (<*>), pure, (<|>))
28+import Control.Monad.Catch (try, catch, finally, mask, onException)
29+import Control.Applicative ((<|>))
3030import 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+ )
3238import Control.Distributed.Process.Internal.Types
33− ( NodeId(nodeAddress)
34− , LocalNode(localEndPoint)
39+ ( LocalNode(localEndPoint)
3540 , ProcessExitException(..)
3641 , nullProcessId
3742 , createUnencodedMessage
@@ -65,7 +70,7 @@ expectThat a matcher = case res of
6570forkTry :: IO () -> IO ThreadId
6671forkTry p = do
6772 tid <- myThreadId
68− forkIO $ Ex.catch p (\e -> throwTo tid (e :: SomeException))
73+ forkIO $ catch p (\e -> throwTo tid (e :: SomeException))
6974
7075-- | The ping server from the paper
7176ping :: Process ()
@@ -700,8 +705,8 @@ testRemoteRegistry TestTransport{..} = do
700705 (\(RegisterReply _ _ _) -> return ()) ]
701706 registerRemoteAsync nid1 "ping" deadProcess
702707 receiveWait [
703− matchIf (\(RegisterReply label' False (Just pid)) ->
704− "ping" == label' && pid == pingServer)
708+ matchIf (\(RegisterReply label' False (Just pid'')) ->
709+ "ping" == label' && pid'' == pingServer)
705710 (\(RegisterReply _ _ _) -> return ()) ]
706711 unregisterRemoteAsync nid1 "dead"
707712 receiveWait [
distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs+1−1
@@ -486,7 +486,7 @@ testSpawnReconnect :: TestTransport -> RemoteTable -> Assertion
486486testSpawnReconnect testtrans@TestTransport{..} rtable = do
487487 [node1, node2] <- replicateM 2 $ newLocalNode testTransport rtable
488488 let nid1 = localNodeId node1
489− nid2 = localNodeId node2
489+ -- nid2 = localNodeId node2
490490 done <- newEmptyMVar
491491 iv <- newMVar (0 :: Int)
492492
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs−2
@@ -4,7 +4,6 @@ module Control.Distributed.Process.Tests.Mx (tests) where
44import Control.Distributed.Process.Tests.Internal.Utils
55import Network.Transport.Test (TestTransport(..))
66
7−import Control.Concurrent (threadDelay)
87import Control.Distributed.Process
98import Control.Distributed.Process.Node
109import Control.Distributed.Process.Management
@@ -21,7 +20,6 @@ import Control.Distributed.Process.Management
2120 , mxUpdateLocal
2221 , mxNotify
2322 , mxBroadcast
24− , mxGetId
2523 )
2624import Control.Monad (void)
2725import Data.Binary
distributed-process-tests/src/Control/Distributed/Process/Tests/Receive.hs+7−8
@@ -10,13 +10,12 @@ import Network.Transport.Test (TestTransport(..))
1010
1111import Network.Transport (Transport)
1212import Control.Distributed.Process
13−import Control.Distributed.Process.Closure
1413import Control.Distributed.Process.Node
1514
1615import Control.Monad
1716
1817import Test.HUnit (Assertion, (@?=))
19−import Test.Framework (Test, defaultMain)
18+import Test.Framework (Test)
2019import Test.Framework.Providers.HUnit (testCase)
2120
2221-- Tests:
@@ -43,7 +42,7 @@ recTest2 :: ReceivePort ()
4342 -> SendPort String
4443 -> ReceivePort String -> ReceivePort String
4544 -> Process ()
46−recTest2 wait sync r1 r2 = do
45+recTest2 wait sync r1 _ = do
4746 forever $ do
4847 receiveChan wait
4948 r <- receiveWait
@@ -56,7 +55,7 @@ recTest3 :: ReceivePort ()
5655 -> SendPort String
5756 -> ReceivePort String -> ReceivePort String
5857 -> Process ()
59−recTest3 wait sync r1 r2 = do
58+recTest3 wait sync r1 _ = do
6059 forever $ do
6160 receiveChan wait
6261 r <- receiveWait
@@ -69,7 +68,7 @@ recTest4 :: ReceivePort ()
6968 -> SendPort String
7069 -> ReceivePort String -> ReceivePort String
7170 -> Process ()
72−recTest4 wait sync r1 r2 = do
71+recTest4 wait sync r1 _ = do
7372 forever $ do
7473 receiveChan wait
7574 r <- receiveWait
@@ -83,11 +82,11 @@ master :: Process ()
8382master = do
8483 (waits,waitr) <- newChan
8584 (syncs,syncr) <- newChan
86− let go expect = do
85+ let go expected = do
8786 sendChan waits ()
8887 r <- receiveChan syncr
89− liftIO $ print (r,expect, r == expect)
90− liftIO $ r @?= expect
88+ liftIO $ print (r, expected, r == expected)
89+ liftIO $ r @?= expected
9190
9291 liftIO $ putStrLn "---- Test 1 ----"
9392 (s1,r1) <- newChan