{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
module Control.Distributed.Process.Tests.Receive (tests) where
import Network.Transport.Test (TestTransport(..))
import Network.Transport (Transport)
import Control.Distributed.Process
import Control.Distributed.Process.Node
import Control.Monad
import Test.HUnit (Assertion, (@?=))
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
recTest1 :: ReceivePort ()
-> SendPort String
-> ReceivePort String -> ReceivePort String
-> Process ()
recTest1 :: ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest1 ReceivePort ()
wait SendPort String
sync ReceivePort String
r1 ReceivePort String
r2 = do
Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
wait
String
r <- [Match String] -> Process String
forall b. [Match b] -> Process b
receiveWait
[ ReceivePort String -> (String -> Process String) -> Match String
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort String
r1 ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
, ReceivePort String -> (String -> Process String) -> Match String
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort String
r2 ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
]
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
sync String
r
recTest2 :: ReceivePort ()
-> SendPort String
-> ReceivePort String -> ReceivePort String
-> Process ()
recTest2 :: ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest2 ReceivePort ()
wait SendPort String
sync ReceivePort String
r1 ReceivePort String
_ = do
Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
wait
String
r <- [Match String] -> Process String
forall b. [Match b] -> Process b
receiveWait
[ ReceivePort String -> (String -> Process String) -> Match String
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort String
r1 ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
, (String -> Bool) -> (String -> Process String) -> Match String
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"foo") ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
]
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
sync String
r
recTest3 :: ReceivePort ()
-> SendPort String
-> ReceivePort String -> ReceivePort String
-> Process ()
recTest3 :: ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest3 ReceivePort ()
wait SendPort String
sync ReceivePort String
r1 ReceivePort String
_ = do
Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
wait
String
r <- [Match String] -> Process String
forall b. [Match b] -> Process b
receiveWait
[ (String -> Bool) -> (String -> Process String) -> Match String
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"foo") ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
, ReceivePort String -> (String -> Process String) -> Match String
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort String
r1 ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
]
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
sync String
r
recTest4 :: ReceivePort ()
-> SendPort String
-> ReceivePort String -> ReceivePort String
-> Process ()
recTest4 :: ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest4 ReceivePort ()
wait SendPort String
sync ReceivePort String
r1 ReceivePort String
_ = do
Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
wait
String
r <- [Match String] -> Process String
forall b. [Match b] -> Process b
receiveWait
[ (String -> Bool) -> (String -> Process String) -> Match String
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"foo") ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
, ReceivePort String -> (String -> Process String) -> Match String
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort String
r1 ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
, (String -> Bool) -> (String -> Process String) -> Match String
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bar") ((String -> Process String) -> Match String)
-> (String -> Process String) -> Match String
forall a b. (a -> b) -> a -> b
$ \String
s -> String -> Process String
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"received3 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
]
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
sync String
r
master :: Process ()
master :: Process ()
master = do
(SendPort ()
waits,ReceivePort ()
waitr) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort String
syncs,ReceivePort String
syncr) <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
let go :: String -> Process ()
go String
expected = do
SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
waits ()
String
r <- ReceivePort String -> Process String
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort String
syncr
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ (String, String, Bool) -> IO ()
forall a. Show a => a -> IO ()
print (String
r, String
expected, String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected)
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String
r String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= String
expected
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"---- Test 1 ----"
(SendPort String
s1,ReceivePort String
r1) <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort String
s2,ReceivePort String
r2) <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
p <- Process () -> Process ProcessId
spawnLocal (ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest1 ReceivePort ()
waitr SendPort String
syncs ReceivePort String
r1 ReceivePort String
r2)
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1 String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 a"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s2 String
"b" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 b"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1 String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s2 String
"b" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 a"
String -> Process ()
go String
"received2 b"
ProcessId -> String -> Process ()
kill ProcessId
p String
"BANG"
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"\n---- Test 2 ----"
(SendPort String
s1',ReceivePort String
r1') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort String
_ ,ReceivePort String
r2') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
p' <- Process () -> Process ProcessId
spawnLocal (ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest2 ReceivePort ()
waitr SendPort String
syncs ReceivePort String
r1' ReceivePort String
r2')
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 a"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p' String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 foo"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 a"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p String
"bar" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 a"
String -> Process ()
go String
"received2 foo"
ProcessId -> String -> Process ()
kill ProcessId
p' String
"BANG"
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"\n---- Test 3 ----"
(SendPort String
s1'',ReceivePort String
r1'') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort String
_ ,ReceivePort String
r2'') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
p'' <- Process () -> Process ProcessId
spawnLocal (ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest3 ReceivePort ()
waitr SendPort String
syncs ReceivePort String
r1'' ReceivePort String
r2'')
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1'' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 a"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p'' String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 foo"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1'' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 foo"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1'' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p String
"bar" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 a"
String -> Process ()
go String
"received2 a"
ProcessId -> String -> Process ()
kill ProcessId
p'' String
"BANG"
IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"\n---- Test 4 ----"
(SendPort String
s1''',ReceivePort String
r1''') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort String
_ ,ReceivePort String
r2''') <- Process (SendPort String, ReceivePort String)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
p''' <- Process () -> Process ProcessId
spawnLocal (ReceivePort ()
-> SendPort String
-> ReceivePort String
-> ReceivePort String
-> Process ()
recTest4 ReceivePort ()
waitr SendPort String
syncs ReceivePort String
r1''' ReceivePort String
r2''')
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1''' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 a"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p''' String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 foo"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p''' String
"bar" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received3 bar"
SendPort String -> String -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort String
s1''' String
"a" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p''' String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 foo"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p''' String
"bar" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received2 a"
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p''' String
"foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received1 foo" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Process ()
go String
"received3 bar"
ProcessId -> String -> Process ()
kill ProcessId
p''' String
"BANG"
Process ()
forall a. Process a
terminate
testReceive :: Transport -> RemoteTable -> Assertion
testReceive :: Transport -> RemoteTable -> IO ()
testReceive Transport
transport RemoteTable
rtable = do
LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
transport RemoteTable
rtable
LocalNode -> Process () -> IO ()
runProcess LocalNode
node (Process () -> IO ()) -> Process () -> IO ()
forall a b. (a -> b) -> a -> b
$ Process ()
master
tests :: TestTransport -> IO [Test]
tests :: TestTransport -> IO [Test]
tests TestTransport{Transport
EndPointAddress -> EndPointAddress -> IO ()
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> IO ()
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> IO ()
testTransport :: TestTransport -> Transport
..} = do
let rtable :: RemoteTable
rtable = RemoteTable
initRemoteTable
[Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
[ String -> IO () -> Test
testCase String
"testReceive" (Transport -> RemoteTable -> IO ()
testReceive Transport
testTransport RemoteTable
rtable) ]