@@ -2,6 +2,14 @@
22{-# OPTIONS_GHC -Wall #-}
33import Control.Distributed.Process
44import 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+ )
513
614import Control.Monad
715import Text.Printf
@@ -9,11 +17,9 @@ import Data.DeriveTH
917import Data.Binary
1018import Data.Typeable
1119
12−import DistribUtils
13−
14−import Test.Framework (defaultMain, testGroup)
15−import Test.Framework.Providers.HUnit
16−import Test.HUnit
20+import Test.HUnit (Assertion, (@?=))
21+import Test.Framework (Test, defaultMain)
22+import Test.Framework.Providers.HUnit (testCase)
1723
1824-- Tests:
1925
@@ -76,8 +82,8 @@ recTest4 wait sync r1 r2 = do
7682 sendChan sync r
7783
7884
79−master :: [NodeId] -> Process ()
80−master peers = do
85+master :: Process ()
86+master = do
8187
8288 (waits,waitr) <- newChan
8389 (syncs,syncr) <- newChan
@@ -142,8 +148,21 @@ master peers = do
142148 terminate
143149
144150
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+
145161-- 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.
147163
148164main :: 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)