git.iko.soy/distributed-process
on master help sign in
Remove dependency on a local module of mine
e822542Simon Marlow
distributed-process/tests/TestReceive.hs+28−9
compare with master
unifiedsplit
@@ -2,6 +2,14 @@
2{-# OPTIONS_GHC -Wall #-}
2{-# OPTIONS_GHC -Wall #-}
3import Control.Distributed.Process
3import Control.Distributed.Process
4import Control.Distributed.Process.Closure
4import Control.Distributed.Process.Closure
5+import Control.Distributed.Process.Node
6+
7+import Network.Transport (Transport)
8+import Network.Transport.TCP
9+ ( createTransportExposeInternals
10+ , defaultTCPParameters
11+ , TransportInternals(socketBetween)
12+ )
5
13
6import Control.Monad
14import Control.Monad
7import Text.Printf
15import Text.Printf
@@ -9,11 +17,9 @@ import Data.DeriveTH
9import Data.Binary
17import Data.Binary
10import Data.Typeable
18import Data.Typeable
11
19
12−import DistribUtils
20+import Test.HUnit (Assertion, (@?=))
13−
14−import Test.Framework (defaultMain, testGroup)
21+import Test.Framework (Test, defaultMain)
15−import Test.Framework.Providers.HUnit
22+import Test.Framework.Providers.HUnit (testCase)
16−import Test.HUnit
17
23
18-- Tests:
24-- Tests:
19
25
@@ -76,8 +82,8 @@ recTest4 wait sync r1 r2 = do
76 sendChan sync r
82 sendChan sync r
77
83
78
84
79−master :: [NodeId] -> Process ()
85+master :: Process ()
80−master peers = do
86+master = do
81
87
82 (waits,waitr) <- newChan
88 (waits,waitr) <- newChan
83 (syncs,syncr) <- newChan
89 (syncs,syncr) <- newChan
@@ -142,8 +148,21 @@ master peers = do
142 terminate
148 terminate
143
149
144
150
151+testReceive :: Transport -> RemoteTable -> Assertion
152+testReceive transport rtable = do
153+ node <- newLocalNode transport rtable
154+ runProcess node $ master
155+
156+tests :: (Transport, TransportInternals) -> RemoteTable -> [Test]
157+tests (transport, transportInternals) rtable = [
158+ testCase "testReceive" (testReceive transport rtable)
159+ ]
160+
145-- NB. test doesn't work, because failure exceptions don't get
161-- NB. test doesn't work, because failure exceptions don't get
146−-- propagated.
162+-- propagated. The test always claims to succeed, even if it failed.
147
163
148main :: IO ()
164main :: IO ()
149−main = defaultMain [ testCase "all" $ distribMain master id ]
165+main = do
166+ Right transport <- createTransportExposeInternals "127.0.0.1" "8080" defaultTCPParameters
167+ let rtable = initRemoteTable
168+ defaultMain (tests transport rtable)