module Control.Distributed.Process.Tests.CH (tests) where
#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
import Network.Transport.Test (TestTransport(..))
import Data.Binary (Binary(..))
import Data.Typeable (Typeable)
import Data.Foldable (forM_)
import Data.Function (fix)
import Data.IORef
( readIORef
, writeIORef
, newIORef
)
import Control.Concurrent (forkIO, threadDelay, myThreadId, throwTo, ThreadId, yield)
import Control.Concurrent.MVar
( MVar
, newEmptyMVar
, putMVar
, takeMVar
, readMVar
)
import Control.Monad (replicateM_, replicateM, forever, void, unless, join)
import Control.Exception (SomeException, throwIO, ErrorCall(..))
import Control.Monad.Catch (try, catch, finally, mask, onException)
import Control.Applicative ((<|>))
import qualified Network.Transport as NT (closeEndPoint, EndPointAddress)
import Control.Distributed.Process hiding
( try
, catch
, finally
, mask
, onException
)
import Control.Distributed.Process.Internal.Types
( LocalNode(localEndPoint)
, ProcessExitException(..)
, nullProcessId
, createUnencodedMessage
)
import Control.Distributed.Process.Node
import Control.Distributed.Process.Tests.Internal.Utils (pause)
import Control.Distributed.Process.Serializable (Serializable)
import Data.Maybe (isNothing, isJust)
import Test.HUnit (Assertion, assertBool, assertFailure)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Control.Rematch hiding (match, isNothing, isJust)
import Control.Rematch.Run (Match(..))
newtype Ping = Ping ProcessId
deriving (Typeable, Get Ping
[Ping] -> Put
Ping -> Put
(Ping -> Put) -> Get Ping -> ([Ping] -> Put) -> Binary Ping
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Ping -> Put
put :: Ping -> Put
$cget :: Get Ping
get :: Get Ping
$cputList :: [Ping] -> Put
putList :: [Ping] -> Put
Binary, Int -> Ping -> ShowS
[Ping] -> ShowS
Ping -> String
(Int -> Ping -> ShowS)
-> (Ping -> String) -> ([Ping] -> ShowS) -> Show Ping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ping -> ShowS
showsPrec :: Int -> Ping -> ShowS
$cshow :: Ping -> String
show :: Ping -> String
$cshowList :: [Ping] -> ShowS
showList :: [Ping] -> ShowS
Show)
newtype Pong = Pong ProcessId
deriving (Typeable, Get Pong
[Pong] -> Put
Pong -> Put
(Pong -> Put) -> Get Pong -> ([Pong] -> Put) -> Binary Pong
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Pong -> Put
put :: Pong -> Put
$cget :: Get Pong
get :: Get Pong
$cputList :: [Pong] -> Put
putList :: [Pong] -> Put
Binary, Int -> Pong -> ShowS
[Pong] -> ShowS
Pong -> String
(Int -> Pong -> ShowS)
-> (Pong -> String) -> ([Pong] -> ShowS) -> Show Pong
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pong -> ShowS
showsPrec :: Int -> Pong -> ShowS
$cshow :: Pong -> String
show :: Pong -> String
$cshowList :: [Pong] -> ShowS
showList :: [Pong] -> ShowS
Show)
expectThat :: a -> Matcher a -> Assertion
expectThat :: forall a. a -> Matcher a -> Assertion
expectThat a
a Matcher a
matcher = case Match
res of
Match
MatchSuccess -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(MatchFailure String
msg) -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
msg
where res :: Match
res = Matcher a -> a -> Match
forall a. Matcher a -> a -> Match
runMatch Matcher a
matcher a
a
forkTry :: IO () -> IO ThreadId
forkTry :: Assertion -> IO ThreadId
forkTry Assertion
p = do
ThreadId
tid <- IO ThreadId
myThreadId
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Assertion -> (SomeException -> Assertion) -> Assertion
forall e a.
(HasCallStack, Exception e) =>
IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch Assertion
p (\SomeException
e -> ThreadId -> SomeException -> Assertion
forall e. Exception e => ThreadId -> e -> Assertion
throwTo ThreadId
tid (SomeException
e :: SomeException))
ping :: Process ()
ping :: Process ()
ping = do
Pong ProcessId
partner <- Process Pong
forall a. Serializable a => Process a
expect
ProcessId
self <- Process ProcessId
getSelfPid
ProcessId -> Ping -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
partner (ProcessId -> Ping
Ping ProcessId
self)
Process ()
ping
verifyClient :: String -> MVar Bool -> IO ()
verifyClient :: String -> MVar Bool -> Assertion
verifyClient String
s MVar Bool
b = MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
b IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
s
expectPing :: MVar Bool -> Process ()
expectPing :: MVar Bool -> Process ()
expectPing MVar Bool
mv = Process Ping
forall a. Serializable a => Process a
expect Process Ping -> (Ping -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Ping -> Assertion) -> Ping -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
mv (Bool -> Assertion) -> (Ping -> Bool) -> Ping -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ping -> Bool
checkPing
where
checkPing :: Ping -> Bool
checkPing (Ping ProcessId
_) = Bool
True
whereisRemote :: NodeId -> String -> Process (Maybe ProcessId)
whereisRemote :: NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid String
string = do
NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
string
[Match (Maybe ProcessId)] -> Process (Maybe ProcessId)
forall b. [Match b] -> Process b
receiveWait [
(WhereIsReply -> Process (Maybe ProcessId))
-> Match (Maybe ProcessId)
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(WhereIsReply String
_ Maybe ProcessId
mPid) -> Maybe ProcessId -> Process (Maybe ProcessId)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessId
mPid)
]
verifyWhereIsRemote :: NodeId -> String -> Process ProcessId
verifyWhereIsRemote :: NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
n String
s = NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
n String
s Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process ProcessId
-> (ProcessId -> Process ProcessId)
-> Maybe ProcessId
-> Process ProcessId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Process ProcessId
forall a b. Serializable a => a -> Process b
die String
"remote name not found") ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
syncBreakConnection :: (NT.EndPointAddress -> NT.EndPointAddress -> IO ()) -> LocalNode -> LocalNode -> IO ()
syncBreakConnection :: (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
breakConnection LocalNode
nid0 LocalNode
nid1 = do
MVar ProcessId
m <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
nid1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
m
LocalNode -> Process () -> Assertion
runProcess LocalNode
nid0 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
m
ProcessId
pinger <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them ()
MonitorRef
_ <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
nid1)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ EndPointAddress -> EndPointAddress -> Assertion
breakConnection (NodeId -> EndPointAddress
nodeAddress (NodeId -> EndPointAddress) -> NodeId -> EndPointAddress
forall a b. (a -> b) -> a -> b
$ LocalNode -> NodeId
localNodeId LocalNode
nid0)
(NodeId -> EndPointAddress
nodeAddress (NodeId -> EndPointAddress) -> NodeId -> EndPointAddress
forall a b. (a -> b) -> a -> b
$ LocalNode -> NodeId
localNodeId LocalNode
nid1)
NodeMonitorNotification MonitorRef
_ NodeId
_ DiedReason
_ <- Process NodeMonitorNotification
forall a. Serializable a => Process a
expect
ProcessId -> String -> Process ()
kill ProcessId
pinger String
"finished"
() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Add = Add ProcessId Double Double deriving (Typeable)
data Divide = Divide ProcessId Double Double deriving (Typeable)
data DivByZero = DivByZero deriving (Typeable)
instance Binary Add where
put :: Add -> Put
put (Add ProcessId
pid Double
x Double
y) = ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
y
get :: Get Add
get = ProcessId -> Double -> Double -> Add
Add (ProcessId -> Double -> Double -> Add)
-> Get ProcessId -> Get (Double -> Double -> Add)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Double -> Double -> Add) -> Get Double -> Get (Double -> Add)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get Get (Double -> Add) -> Get Double -> Get Add
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get
instance Binary Divide where
put :: Divide -> Put
put (Divide ProcessId
pid Double
x Double
y) = ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
y
get :: Get Divide
get = ProcessId -> Double -> Double -> Divide
Divide (ProcessId -> Double -> Double -> Divide)
-> Get ProcessId -> Get (Double -> Double -> Divide)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Double -> Double -> Divide)
-> Get Double -> Get (Double -> Divide)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get Get (Double -> Divide) -> Get Double -> Get Divide
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get
instance Binary DivByZero where
put :: DivByZero -> Put
put DivByZero
DivByZero = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
get :: Get DivByZero
get = DivByZero -> Get DivByZero
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DivByZero
DivByZero
math :: Process ()
math :: Process ()
math = do
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
[ (Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Add ProcessId
pid Double
x Double
y) -> ProcessId -> Double -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y))
, (Divide -> Bool) -> (Divide -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Divide ProcessId
_ Double
_ Double
y) -> Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0)
(\(Divide ProcessId
pid Double
x Double
y) -> ProcessId -> Double -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y))
, (Divide -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Divide ProcessId
pid Double
_ Double
_) -> ProcessId -> DivByZero -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid DivByZero
DivByZero)
]
Process ()
math
monitorOrLink :: Bool
-> ProcessId
-> Maybe (MVar ())
-> Process (Maybe MonitorRef)
monitorOrLink :: Bool -> ProcessId -> Maybe (MVar ()) -> Process (Maybe MonitorRef)
monitorOrLink Bool
mOrL ProcessId
pid Maybe (MVar ())
mSignal = do
Maybe MonitorRef
result <- if Bool
mOrL then MonitorRef -> Maybe MonitorRef
forall a. a -> Maybe a
Just (MonitorRef -> Maybe MonitorRef)
-> Process MonitorRef -> Process (Maybe MonitorRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessId -> Process MonitorRef
monitor ProcessId
pid
else ProcessId -> Process ()
link ProcessId
pid Process ()
-> Process (Maybe MonitorRef) -> Process (Maybe MonitorRef)
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe MonitorRef -> Process (Maybe MonitorRef)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MonitorRef
forall a. Maybe a
Nothing
Maybe (MVar ()) -> (MVar () -> Process ProcessId) -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (MVar ())
mSignal ((MVar () -> Process ProcessId) -> Process ())
-> (MVar () -> Process ProcessId) -> Process ()
forall a b. (a -> b) -> a -> b
$ \MVar ()
signal -> do
ProcessId
self <- Process ProcessId
getSelfPid
Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
let waitForMOrL :: Process ()
waitForMOrL = do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
Maybe ProcessInfo
mpinfo <- ProcessId -> Process (Maybe ProcessInfo)
getProcessInfo ProcessId
pid
case Maybe ProcessInfo
mpinfo of
Maybe ProcessInfo
Nothing -> Process ()
waitForMOrL
Just ProcessInfo
pinfo ->
if Bool
mOrL then
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe MonitorRef
result Maybe MonitorRef -> Maybe MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> [(ProcessId, MonitorRef)] -> Maybe MonitorRef
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ProcessId
self (ProcessInfo -> [(ProcessId, MonitorRef)]
infoMonitors ProcessInfo
pinfo)) Process ()
waitForMOrL
else
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProcessId -> [ProcessId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ProcessId
self ([ProcessId] -> Bool) -> [ProcessId] -> Bool
forall a b. (a -> b) -> a -> b
$ ProcessInfo -> [ProcessId]
infoLinks ProcessInfo
pinfo) Process ()
waitForMOrL
Process ()
waitForMOrL
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
signal ()
Maybe MonitorRef -> Process (Maybe MonitorRef)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MonitorRef
result
monitorTestProcess :: ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess :: ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
reason Maybe (MVar ())
monitorSetup MVar ()
done =
Process () -> (ProcessLinkException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (do Maybe MonitorRef
mRef <- Bool -> ProcessId -> Maybe (MVar ()) -> Process (Maybe MonitorRef)
monitorOrLink Bool
mOrL ProcessId
theirAddr Maybe (MVar ())
monitorSetup
case (Bool
un, Maybe MonitorRef
mRef) of
(Bool
True, Maybe MonitorRef
Nothing) -> do
ProcessId -> Process ()
unlink ProcessId
theirAddr
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
(Bool
True, Just MonitorRef
ref) -> do
MonitorRef -> Process ()
unmonitor MonitorRef
ref
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
(Bool
False, Maybe MonitorRef
ref) -> do
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(ProcessMonitorNotification MonitorRef
ref' ProcessId
pid DiedReason
reason') -> do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Bad Monitor Signal"
(MonitorRef -> Maybe MonitorRef
forall a. a -> Maybe a
Just MonitorRef
ref' Maybe MonitorRef -> Maybe MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe MonitorRef
ref Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
theirAddr Bool -> Bool -> Bool
&&
Bool
mOrL Bool -> Bool -> Bool
&& DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
reason')
MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
]
)
(\(ProcessLinkException ProcessId
pid DiedReason
reason') -> do
(Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"link exception unmatched" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
theirAddr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mOrL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
un Bool -> Bool -> Bool
&& DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
reason')
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
)
testPing :: TestTransport -> Assertion
testPing :: TestTransport -> Assertion
testPing TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
ping
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
pingServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr
let numPings :: Int
numPings = Int
10000
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
numPings (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pingServer (ProcessId -> Pong
Pong ProcessId
pid)
Maybe Ping
p <- Int -> Process (Maybe Ping)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
3000000
case Maybe Ping
p of
Just (Ping ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe Ping
Nothing -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Failed to receive Ping"
MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ProcessId
deadProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
forall a. Serializable a => Process a
expect
LocalNode -> Assertion
closeLocalNode LocalNode
localNode
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
deadProcess ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
deadProcess
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedDisconnect Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ProcessId
monitoredProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
monitoredProcess ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
monitoredProcess
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedNormal (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ProcessId
monitoredProcess <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
let err :: IOError
err = String -> IOError
userError String
"Abnormal termination"
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId)
-> (Assertion -> Process ()) -> Assertion -> IO ProcessId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> IO ProcessId) -> Assertion -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
IOError -> Assertion
forall e a. Exception e => e -> IO a
throwIO IOError
err
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
monitoredProcess ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
monitoredProcess
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un (String -> DiedReason
DiedException (IOError -> String
forall a. Show a => a -> String
show IOError
err)) (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId -> Process MonitorRef
monitor ProcessId
theirAddr
Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect :: Process ProcessMonitorNotification
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedUnknownId Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ()
processDead <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId)
-> (Assertion -> Process ()) -> Assertion -> IO ProcessId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> IO ProcessId) -> Assertion -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
processDead ()
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
processDead
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedUnknownId Maybe (MVar ())
forall a. Maybe a
Nothing MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Bool
mOrL Bool
un = do
MVar ProcessId
processAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ProcessId
processAddr2 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
monitorSetup <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ()
forall a. Serializable a => Process a
expect
ProcessId
addr2 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr ProcessId
addr
MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
monitorSetup
EndPoint -> Assertion
NT.closeEndPoint (LocalNode -> EndPoint
localEndPoint LocalNode
localNode)
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processAddr2 ProcessId
addr2
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
theirAddr <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
lc <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processAddr2
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
lc ()
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
-> Bool
-> Bool
-> DiedReason
-> Maybe (MVar ())
-> MVar ()
-> Process ()
monitorTestProcess ProcessId
theirAddr Bool
mOrL Bool
un DiedReason
DiedDisconnect (MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
monitorSetup) MVar ()
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMath :: TestTransport -> Assertion
testMath :: TestTransport -> Assertion
testMath TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar (Double, Double, DivByZero)
clientDone <- IO (MVar (Double, Double, DivByZero))
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
Double
four <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
0)
DivByZero
divByZ <- Process DivByZero
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Double, Double, DivByZero)
-> (Double, Double, DivByZero) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Double, Double, DivByZero)
clientDone (Double
three, Double
four, DivByZero
divByZ)
(Double, Double, DivByZero)
res <- MVar (Double, Double, DivByZero) -> IO (Double, Double, DivByZero)
forall a. MVar a -> IO a
takeMVar MVar (Double, Double, DivByZero)
clientDone
case (Double, Double, DivByZero)
res of
(Double
3, Double
4, DivByZero
DivByZero) -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Double, Double, DivByZero)
_ -> String -> Assertion
forall a. HasCallStack => String -> a
error (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"Something went horribly wrong"
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr1 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ProcessId
serverAddr2 <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
MVar ()
terminated <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr1 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
terminated ()
ProcessId
addr2 <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process ()
ping
MVar () -> Assertion
forall a. MVar a -> IO a
readMVar MVar ()
terminated
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr1 ProcessId
addr1
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr2 ProcessId
addr2
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server1 <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr1
ProcessId
server2 <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr2
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server1 String
"Hi"
ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server2 (ProcessId -> Pong
Pong ProcessId
pid)
MVar Bool -> Process ()
expectPing MVar Bool
clientDone
String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping from server" MVar Bool
clientDone
testTimeout :: TestTransport -> Assertion
testTimeout :: TestTransport -> Assertion
testTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
1000000 [(Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\Add{} -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ()
res Maybe () -> Maybe () -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ()
forall a. Maybe a
Nothing
String -> MVar Bool -> Assertion
verifyClient String
"Expected receiveTimeout to timeout..." MVar Bool
done
testTimeout0 :: TestTransport -> Assertion
testTimeout0 :: TestTransport -> Assertion
testTimeout0 TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
addr <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
partner <- (Process ProcessId -> Process ProcessId) -> Process ProcessId
forall a. (a -> a) -> a
fix ((Process ProcessId -> Process ProcessId) -> Process ProcessId)
-> (Process ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ \Process ProcessId
loop ->
Int -> [Match ProcessId] -> Process (Maybe ProcessId)
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
0 [(Pong -> Process ProcessId) -> Match ProcessId
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Pong ProcessId
partner) -> ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId
partner)]
Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process ProcessId
-> (ProcessId -> Process ProcessId)
-> Maybe ProcessId
-> Process ProcessId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
100000) Process () -> Process ProcessId -> Process ProcessId
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Process ProcessId
loop) ProcessId -> Process ProcessId
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
ProcessId
self <- Process ProcessId
getSelfPid
ProcessId -> Ping -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
partner (ProcessId -> Ping
Ping ProcessId
self)
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
addr
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
serverAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
10000 (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server String
"Irrelevant message"
ProcessId -> Pong -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId -> Pong
Pong ProcessId
pid)
MVar Bool -> Process ()
expectPing MVar Bool
clientDone
String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping from server" MVar Bool
clientDone
testTypedChannels :: TestTransport -> Assertion
testTypedChannels :: TestTransport -> Assertion
testTypedChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar (SendPort (SendPort Bool, Int))
serverChannel <- IO (MVar (SendPort (SendPort Bool, Int)))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (SendPort (SendPort Bool, Int)))
MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
(SendPort (SendPort Bool, Int)
serverSendPort, ReceivePort (SendPort Bool, Int)
rport) <- Process
(SendPort (SendPort Bool, Int), ReceivePort (SendPort Bool, Int))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (SendPort Bool, Int))
-> SendPort (SendPort Bool, Int) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (SendPort Bool, Int))
serverChannel SendPort (SendPort Bool, Int)
serverSendPort
(SendPort Bool
clientSendPort, Int
i) <- ReceivePort (SendPort Bool, Int) -> Process (SendPort Bool, Int)
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort (SendPort Bool, Int)
rport
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
clientSendPort (Int -> Bool
forall a. Integral a => a -> Bool
even Int
i)
() -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
SendPort (SendPort Bool, Int)
serverSendPort <- MVar (SendPort (SendPort Bool, Int))
-> IO (SendPort (SendPort Bool, Int))
forall a. MVar a -> IO a
readMVar MVar (SendPort (SendPort Bool, Int))
serverChannel
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
(SendPort Bool
clientSendPort, ReceivePort Bool
rport) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
SendPort (SendPort Bool, Int) -> (SendPort Bool, Int) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (SendPort Bool, Int)
serverSendPort (SendPort Bool
clientSendPort, Int
5)
Bool
ch <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rport
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
clientDone (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool
ch Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
String -> MVar Bool -> Assertion
verifyClient String
"Expected channel to send 'False'" MVar Bool
clientDone
testMergeChannels :: TestTransport -> Assertion
testMergeChannels :: TestTransport -> Assertion
testMergeChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
True String
"aaabbbccc"
LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
False String
"abcabcabc"
LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
True Bool
True String
"aaabbbcccdddeeefffggghhhiii"
LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
True Bool
False String
"adgadgadgbehbehbehcficficfi"
LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
False Bool
True String
"abcabcabcdefdefdefghighighi"
LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
False Bool
False String
"adgbehcfiadgbehcfiadgbehcfi"
LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
True
LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
False
where
testFlat :: LocalNode -> Bool -> String -> IO ()
testFlat :: LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
biased String
expected = do
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
[ReceivePort Char]
rs <- (Char -> Process (ReceivePort Char))
-> String -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Process (ReceivePort Char)
charChannel String
"abc"
ReceivePort Char
m <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biased [ReceivePort Char]
rs
String
xs <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
9 (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
String -> MVar Bool -> Assertion
verifyClient String
"Expected single layer merge to match expected ordering" MVar Bool
done
testNested :: LocalNode -> Bool -> Bool -> String -> IO ()
testNested :: LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
biasedInner Bool
biasedOuter String
expected = do
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
[[ReceivePort Char]]
rss <- (String -> Process [ReceivePort Char])
-> [String] -> Process [[ReceivePort Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Char -> Process (ReceivePort Char))
-> String -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Process (ReceivePort Char)
charChannel) [String
"abc", String
"def", String
"ghi"]
[ReceivePort Char]
ms <- ([ReceivePort Char] -> Process (ReceivePort Char))
-> [[ReceivePort Char]] -> Process [ReceivePort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biasedInner) [[ReceivePort Char]]
rss
ReceivePort Char
m <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biasedOuter [ReceivePort Char]
ms
String
xs <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
String -> MVar Bool -> Assertion
verifyClient String
"Expected nested channels to match expeted ordering" MVar Bool
done
testBlocked :: LocalNode -> Bool -> IO ()
testBlocked :: LocalNode -> Bool -> Assertion
testBlocked LocalNode
localNode Bool
biased = do
[MVar (SendPort Char)]
vs <- Int -> IO (MVar (SendPort Char)) -> IO [MVar (SendPort Char)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 IO (MVar (SendPort Char))
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
[SendPort Char]
ss <- IO [SendPort Char] -> Process [SendPort Char]
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SendPort Char] -> Process [SendPort Char])
-> IO [SendPort Char] -> Process [SendPort Char]
forall a b. (a -> b) -> a -> b
$ (MVar (SendPort Char) -> IO (SendPort Char))
-> [MVar (SendPort Char)] -> IO [SendPort Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM MVar (SendPort Char) -> IO (SendPort Char)
forall a. MVar a -> IO a
readMVar [MVar (SendPort Char)]
vs
case [SendPort Char]
ss of
[SendPort Char
sa, SendPort Char
sb, SendPort Char
sc] ->
((SendPort Char, Char) -> Process ())
-> [(SendPort Char, Char)] -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Process ()
pause Int
10000) (Process () -> Process ())
-> ((SendPort Char, Char) -> Process ())
-> (SendPort Char, Char)
-> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SendPort Char -> Char -> Process ())
-> (SendPort Char, Char) -> Process ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SendPort Char -> Char -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan)
[
(SendPort Char
sa, Char
'a')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sa, Char
'a')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sa, Char
'a')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sa, Char
'a')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sa, Char
'a')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sc, Char
'c')
, (SendPort Char
sb, Char
'b')
, (SendPort Char
sa, Char
'a')
]
[SendPort Char]
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
([SendPort Char]
ss, [ReceivePort Char]
rs) <- [(SendPort Char, ReceivePort Char)]
-> ([SendPort Char], [ReceivePort Char])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(SendPort Char, ReceivePort Char)]
-> ([SendPort Char], [ReceivePort Char]))
-> Process [(SendPort Char, ReceivePort Char)]
-> Process ([SendPort Char], [ReceivePort Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Process (SendPort Char, ReceivePort Char)
-> Process [(SendPort Char, ReceivePort Char)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 Process (SendPort Char, ReceivePort Char)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ ((MVar (SendPort Char), SendPort Char) -> Assertion)
-> [(MVar (SendPort Char), SendPort Char)] -> Assertion
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((MVar (SendPort Char) -> SendPort Char -> Assertion)
-> (MVar (SendPort Char), SendPort Char) -> Assertion
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MVar (SendPort Char) -> SendPort Char -> Assertion
forall a. MVar a -> a -> Assertion
putMVar) ([(MVar (SendPort Char), SendPort Char)] -> Assertion)
-> [(MVar (SendPort Char), SendPort Char)] -> Assertion
forall a b. (a -> b) -> a -> b
$ [MVar (SendPort Char)]
-> [SendPort Char] -> [(MVar (SendPort Char), SendPort Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MVar (SendPort Char)]
vs [SendPort Char]
ss
ReceivePort Char
m <- Bool -> [ReceivePort Char] -> Process (ReceivePort Char)
forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
biased [ReceivePort Char]
rs
String
xs <- Int -> Process Char -> Process String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) (Process Char -> Process String) -> Process Char -> Process String
forall a b. (a -> b) -> a -> b
$ ReceivePort Char -> Process Char
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Char
m
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"abcacbbacbcacabcba"
String -> MVar Bool -> Assertion
verifyClient String
"Expected merged ports to match expected ordering" MVar Bool
done
mergePorts :: Serializable a => Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts :: forall a.
Serializable a =>
Bool -> [ReceivePort a] -> Process (ReceivePort a)
mergePorts Bool
True = [ReceivePort a] -> Process (ReceivePort a)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsBiased
mergePorts Bool
False = [ReceivePort a] -> Process (ReceivePort a)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsRR
charChannel :: Char -> Process (ReceivePort Char)
charChannel :: Char -> Process (ReceivePort Char)
charChannel Char
c = do
(SendPort Char
sport, ReceivePort Char
rport) <- Process (SendPort Char, ReceivePort Char)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
Int -> Process () -> Process ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ SendPort Char -> Char -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Char
sport Char
c
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
10000
ReceivePort Char -> Process (ReceivePort Char)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ReceivePort Char
rport
testTerminate :: TestTransport -> Assertion
testTerminate :: TestTransport -> Assertion
testTerminate TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
Either ProcessTerminationException ()
e <- Process () -> Process (Either ProcessTerminationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try Process ()
forall a. Process a
terminate :: Process (Either ProcessTerminationException ())
if (ProcessTerminationException -> String)
-> (() -> String)
-> Either ProcessTerminationException ()
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ProcessTerminationException -> String
forall a. Show a => a -> String
show () -> String
forall a. Show a => a -> String
show Either ProcessTerminationException ()
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessTerminationException -> String
forall a. Show a => a -> String
show ProcessTerminationException
ProcessTerminationException
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Unexpected result from terminate"
testMonitorNode :: TestTransport -> Assertion
testMonitorNode :: TestTransport -> Assertion
testMonitorNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
[LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Assertion
closeLocalNode LocalNode
node1
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
MonitorRef
ref <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
node1)
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(NodeMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
DiedDisconnect) ->
Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& NodeId
nid NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== LocalNode -> NodeId
localNodeId LocalNode
node1)
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done
String -> MVar Bool -> Assertion
verifyClient String
"Expected NodeMonitorNotification with matching ref & nodeId" MVar Bool
done
testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
[LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
ready <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
readyr <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
ProcessId
p <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
MonitorRef
ref <- NodeId -> Process MonitorRef
monitorNode (LocalNode -> NodeId
localNodeId LocalNode
node1)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
ready ()
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
readyr
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p ()
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(NodeMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
_) ->
(Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& NodeId
nid NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== LocalNode -> NodeId
localNodeId LocalNode
node1))
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
ready
LocalNode -> Assertion
closeLocalNode LocalNode
node1
MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
readyr ()
String -> MVar Bool -> Assertion
verifyClient String
"Expected NodeMonitorNotification for LIVE node" MVar Bool
done
testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
[LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Bool
gotNotification <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
SendPort ()
sport <- Process (SendPort ())
forall a. Serializable a => Process a
expect :: Process (SendPort ())
MonitorRef
ref <- SendPort () -> Process MonitorRef
forall a. Serializable a => SendPort a -> Process MonitorRef
monitorPort SendPort ()
sport
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(PortMonitorNotification -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(PortMonitorNotification MonitorRef
ref' SendPortId
port' DiedReason
reason) ->
Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref' MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref Bool -> Bool -> Bool
&& SendPortId
port' SendPortId -> SendPortId -> Bool
forall a. Eq a => a -> a -> Bool
== SendPort () -> SendPortId
forall a. SendPort a -> SendPortId
sendPortId SendPort ()
sport Bool -> Bool -> Bool
&&
(DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
DiedNormal Bool -> Bool -> Bool
|| DiedReason
reason DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
DiedUnknownId))
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
gotNotification
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
(SendPort ()
sport, ReceivePort ()
_) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
ProcessId -> SendPort () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid SendPort ()
sport
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
String -> MVar Bool -> Assertion
verifyClient String
"Expected PortMonitorNotification" MVar Bool
gotNotification
testRegistry :: TestTransport -> Assertion
testRegistry :: TestTransport -> Assertion
testRegistry TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node Process ()
ping
ProcessId
deadProcess <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
String -> ProcessId -> Process ()
register String
"ping" ProcessId
pingServer
String -> Process (Maybe ProcessId)
whereis String
"ping" Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected ping" (Bool -> Assertion)
-> (Maybe ProcessId -> Bool) -> Maybe ProcessId -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer)
ProcessId
us <- Process ProcessId
getSelfPid
String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(Ping -> Bool) -> (Ping -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Ping ProcessId
pid') -> ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid') (Process () -> Ping -> Process ()
forall a b. a -> b -> a
const (Process () -> Ping -> Process ())
-> Process () -> Ping -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
String -> Maybe Any -> ProcessId -> Process ()
forall {p}. String -> p -> ProcessId -> Process ()
checkRegException String
"dead" Maybe Any
forall a. Maybe a
Nothing ProcessId
deadProcess
String -> Maybe ProcessId -> ProcessId -> Process ()
forall {p}. String -> p -> ProcessId -> Process ()
checkRegException String
"ping" (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer) ProcessId
deadProcess
Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> Process ()
unregister String
"dead") Process (Either ProcessRegistrationException ())
-> (Either ProcessRegistrationException () -> Process ())
-> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Maybe Any
-> Either ProcessRegistrationException ()
-> Process ()
forall {b} {p} {p}.
Show b =>
p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg String
"dead" Maybe Any
forall a. Maybe a
Nothing
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
where
checkRegException :: String -> p -> ProcessId -> Process ()
checkRegException String
name p
pid ProcessId
dead =
Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> ProcessId -> Process ()
register String
name ProcessId
dead) Process (Either ProcessRegistrationException ())
-> (Either ProcessRegistrationException () -> Process ())
-> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> p -> Either ProcessRegistrationException () -> Process ()
forall {b} {p} {p}.
Show b =>
p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg String
name p
pid
checkReg :: p -> p -> Either ProcessRegistrationException b -> Process ()
checkReg p
_ p
_ Either ProcessRegistrationException b
res =
case Either ProcessRegistrationException b
res of
Left (ProcessRegistrationException String
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Either ProcessRegistrationException b
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Registration" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either ProcessRegistrationException b -> String
forall a. Show a => a -> String
show Either ProcessRegistrationException b
res
testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 Process ()
ping
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
String -> ProcessId -> Process ()
register String
"ping" ProcessId
pingServer
String -> Process (Maybe ProcessId)
whereis String
"ping" Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected ping" (Bool -> Assertion)
-> (Maybe ProcessId -> Bool) -> Maybe ProcessId -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pingServer)
ProcessId
us <- Process ProcessId
getSelfPid
String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(Ping -> Bool) -> (Ping -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(Ping ProcessId
pid') -> ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
(Process () -> Ping -> Process ()
forall a b. a -> b -> a
const (Process () -> Ping -> Process ())
-> Process () -> Ping -> Process ()
forall a b. (a -> b) -> a -> b
$ Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
]
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testRemoteRegistry :: TestTransport -> Assertion
testRemoteRegistry :: TestTransport -> Assertion
testRemoteRegistry TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 Process ()
ping
ProcessId
deadProcess <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
pingServer
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ (Just ProcessId
pid)) ->
String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pingServer)
(\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
ProcessId
pid <- NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"ping"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected pindServer to match pid" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid
ProcessId
us <- Process ProcessId
getSelfPid
NodeId -> String -> Pong -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid1 String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(Ping -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Ping ProcessId
pid') -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected Ping with ping server's ProcessId"
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"dead" ProcessId
deadProcess
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [ (RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"dead" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
f Maybe ProcessId
mPid) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
mPid))
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False Nothing in RegisterReply"
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
deadProcess
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
False Maybe ProcessId
mPid) ->
String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label' Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ProcessId
mPid)
(\(RegisterReply String
_ Bool
f (Just ProcessId
pid'')) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& ProcessId
pid'' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pingServer))
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False and (Just alreadyRegisteredPid) in RegisterReply"
NodeId -> String -> Process ()
unregisterRemoteAsync NodeId
nid1 String
"dead"
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process Bool) -> Match Bool
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"dead" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
f Maybe ProcessId
mPid) -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
f Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
mPid))
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False and Nothing in RegisterReply"
testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Bool
done <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pingServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 Process ()
ping
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"ping" ProcessId
pingServer
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"ping" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
ProcessId
pid <- NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"ping"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected pingServer to match remote name" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid
ProcessId
us <- Process ProcessId
getSelfPid
NodeId -> String -> Pong -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid1 String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
[Match Bool] -> Process Bool
forall b. [Match b] -> Process b
receiveWait [
(Ping -> Process Bool) -> Match Bool
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Ping ProcessId
pid') -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ ProcessId
pingServer ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid')
] Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
done
String -> MVar Bool -> Assertion
verifyClient String
"Expected Ping with ping server's ProcessId" MVar Bool
done
testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Int
done <- IO (MVar Int)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
us <- Process ProcessId
getSelfPid
ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
SendPort Int
sport <- Process (SendPort Int)
forall a. Serializable a => Process a
expect
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
sport (Int
1234 :: Int)
SendPort Int
sport <- (ReceivePort Int -> Process ()) -> Process (SendPort Int)
forall a.
Serializable a =>
(ReceivePort a -> Process ()) -> Process (SendPort a)
spawnChannelLocal ((ReceivePort Int -> Process ()) -> Process (SendPort Int))
-> (ReceivePort Int -> Process ()) -> Process (SendPort Int)
forall a b. (a -> b) -> a -> b
$
\ReceivePort Int
rport -> (ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rport :: Process Int) Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
us
ProcessId -> SendPort Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid SendPort Int
sport
Process Int
forall a. Serializable a => Process a
expect Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Int -> Int -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Int
done
Int
res <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
done
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 1234 :: Int" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Int
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1234 :: Int)
testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Assertion
done <- IO (MVar Assertion)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
NodeId
here <-Process NodeId
getSelfNode
Either SomeException SpawnRef
ev <- Process SpawnRef -> Process (Either SomeException SpawnRef)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Process SpawnRef -> Process (Either SomeException SpawnRef))
-> Process SpawnRef -> Process (Either SomeException SpawnRef)
forall a b. (a -> b) -> a -> b
$ NodeId -> Closure (Process ()) -> Process SpawnRef
spawnAsync NodeId
here (String -> Closure (Process ())
forall a. HasCallStack => String -> a
error String
"boom")
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ case Either SomeException SpawnRef
ev of
Right SpawnRef
_ -> MVar Assertion -> Assertion -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Assertion
done (String -> Assertion
forall a. HasCallStack => String -> a
error String
"Exception didn't fire")
Left (SomeException
_::SomeException) -> MVar Assertion -> Assertion -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Assertion
done (() -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
IO Assertion -> Assertion
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO Assertion -> Assertion) -> IO Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ MVar Assertion -> IO Assertion
forall a. MVar a -> IO a
takeMVar MVar Assertion
done
testReconnect :: TestTransport -> Assertion
testReconnect :: TestTransport -> Assertion
testReconnect TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
[LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
MVar ProcessId
processA <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
[MVar ()
sendTestOk, MVar ()
registerTestOk] <- Int -> IO (MVar ()) -> IO [MVar ()]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
us <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processA ProcessId
us
String
msg1 <- Process String
forall a. Serializable a => Process a
expect
String
msg2 <- Process String
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"messages did not match" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ String
msg1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"message 1" Bool -> Bool -> Bool
&& String
msg2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"message 3"
MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
sendTestOk ()
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processA
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 1" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
100000)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection LocalNode
node1 LocalNode
node2
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 2"
ProcessId -> Process ()
reconnect ProcessId
them
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 3"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
sendTestOk
ProcessId
us <- Process ProcessId
getSelfPid
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"a" ProcessId
us
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"a" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
Maybe ProcessId
_ <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ (EndPointAddress -> EndPointAddress -> Assertion)
-> LocalNode -> LocalNode -> Assertion
syncBreakConnection EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection LocalNode
node1 LocalNode
node2
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"b" ProcessId
us
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"b" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"c" ProcessId
us
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(RegisterReply -> Bool)
-> (RegisterReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(RegisterReply String
label' Bool
_ Maybe ProcessId
_) -> String
"c" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label')
(\(RegisterReply String
_ Bool
_ Maybe ProcessId
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
Maybe ProcessId
mPid <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected remote name to be lost" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ProcessId
mPid Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ProcessId
forall a. Maybe a
Nothing
NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"b"
NodeId -> String -> Process ProcessId
verifyWhereIsRemote NodeId
nid1 String
"c"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
registerTestOk ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
registerTestOk
testUSend :: (ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend :: (ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend ProcessId -> Int -> Process ()
usendPrim TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} Int
numMessages = do
[LocalNode
node1, LocalNode
node2] <- Int -> IO LocalNode -> IO [LocalNode]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IO LocalNode -> IO [LocalNode]) -> IO LocalNode -> IO [LocalNode]
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
let nid1 :: NodeId
nid1 = LocalNode -> NodeId
localNodeId LocalNode
node1
nid2 :: NodeId
nid2 = LocalNode -> NodeId
localNodeId LocalNode
node2
MVar ProcessId
processA <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
usendTestOk <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ (Process () -> (SomeException -> Process ()) -> Process ())
-> (SomeException -> Process ()) -> Process () -> Process ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Process () -> (SomeException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (\SomeException
e -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Assertion
forall a. Show a => a -> Assertion
print (SomeException
e :: SomeException) ) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
ProcessId
us <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
processA ProcessId
us
ProcessId
them <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them ()
MonitorRef
_ <- ProcessId -> Process MonitorRef
monitor ProcessId
them
let
receiveMessages :: Process [Int]
receiveMessages :: Process [Int]
receiveMessages = [Match [Int]] -> Process [Int]
forall b. [Match b] -> Process b
receiveWait
[ (ProcessMonitorNotification -> Process [Int]) -> Match [Int]
forall a b. Serializable a => (a -> Process b) -> Match b
match ((ProcessMonitorNotification -> Process [Int]) -> Match [Int])
-> (ProcessMonitorNotification -> Process [Int]) -> Match [Int]
forall a b. (a -> b) -> a -> b
$ \ProcessMonitorNotification
mn -> case ProcessMonitorNotification
mn of
ProcessMonitorNotification MonitorRef
_ ProcessId
_ DiedReason
DiedDisconnect -> do
ProcessId -> Process MonitorRef
monitor ProcessId
them
Process [Int]
receiveMessages
ProcessMonitorNotification
_ -> [Int] -> Process [Int]
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return []
, (Int -> Process [Int]) -> Match [Int]
forall a b. Serializable a => (a -> Process b) -> Match b
match ((Int -> Process [Int]) -> Match [Int])
-> (Int -> Process [Int]) -> Match [Int]
forall a b. (a -> b) -> a -> b
$ \Int
i -> ([Int] -> [Int]) -> Process [Int] -> Process [Int]
forall a b. (a -> b) -> Process a -> Process b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) Process [Int]
receiveMessages
]
[Int]
msgs <- Process [Int]
receiveMessages
let
isSorted :: [Int] -> Bool
isSorted :: [Int] -> Bool
isSorted (Int
x : xs :: [Int]
xs@(Int
y : [Int]
_)) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y Bool -> Bool -> Bool
&& [Int] -> Bool
isSorted [Int]
xs
isSorted [Int]
_ = Bool
True
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
usendTestOk (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
isSorted [Int]
msgs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
msgs)
LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
them <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
processA
Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them
Process ()
forall a. Serializable a => Process a
expect :: Process ()
[Int] -> (Int -> Process ()) -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1..Int
numMessages] ((Int -> Process ()) -> Process ())
-> (Int -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection (NodeId -> EndPointAddress
nodeAddress NodeId
nid1) (NodeId -> EndPointAddress
nodeAddress NodeId
nid2)
ProcessId -> Int -> Process ()
usendPrim ProcessId
them Int
i
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay Int
30000)
Bool
res <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
usendTestOk
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected failure after sending last msg" Bool
res
testMatchAny :: TestTransport -> Assertion
testMatchAny :: TestTransport -> Assertion
testMatchAny TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar (Double, Double, DivByZero)
clientDone <- IO (MVar (Double, Double, DivByZero))
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
mathServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
ProcessId
proxyServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ 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
Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [ (Message -> Process Message) -> Match Message
forall b. (Message -> Process b) -> Match b
matchAny Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
Message -> ProcessId -> Process ()
forward Message
msg ProcessId
mathServer
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
proxyAddr ProcessId
proxyServer
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
proxyAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
Double
four <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
0)
DivByZero
divByZ <- Process DivByZero
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Double, Double, DivByZero)
-> (Double, Double, DivByZero) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Double, Double, DivByZero)
clientDone (Double
three, Double
four, DivByZero
divByZ)
(Double, Double, DivByZero)
res <- MVar (Double, Double, DivByZero) -> IO (Double, Double, DivByZero)
forall a. MVar a -> IO a
takeMVar MVar (Double, Double, DivByZero)
clientDone
case (Double, Double, DivByZero)
res of
(Double
3, Double
4, DivByZero
DivByZero) -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Double, Double, DivByZero)
_ -> String -> Assertion
forall a. HasCallStack => String -> a
error String
"Unexpected result"
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar Bool
clientDone <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
mathServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode Process ()
math
ProcessId
proxyServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process (Maybe ()) -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process (Maybe ()) -> Process ())
-> Process (Maybe ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ do
[Match (Maybe ())] -> Process (Maybe ())
forall b. [Match b] -> Process b
receiveWait [
(Message -> Process (Maybe ())) -> Match (Maybe ())
forall b. (Message -> Process b) -> Match b
matchAny (ProcessId -> Message -> Process (Maybe ())
maybeForward ProcessId
mathServer)
]
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
proxyAddr ProcessId
proxyServer
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
mathServer <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
proxyAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
Double
three <- Process Double
forall a. Serializable a => Process a
expect :: Process Double
ProcessId -> Divide -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
mathServer (ProcessId -> Double -> Double -> Divide
Divide ProcessId
pid Double
8 Double
2)
Maybe Double
res <- (Int -> Process (Maybe Double)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
100000) :: Process (Maybe Double)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
clientDone (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Double
three Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
3 Bool -> Bool -> Bool
&& Maybe Double
res Maybe Double -> Maybe Double -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Double
forall a. Maybe a
Nothing
String -> MVar Bool -> Assertion
verifyClient String
"Expected Nothing (i.e. timeout)" MVar Bool
clientDone
where maybeForward :: ProcessId -> Message -> Process (Maybe ())
maybeForward :: ProcessId -> Message -> Process (Maybe ())
maybeForward ProcessId
s Message
msg =
Message -> (Add -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
msg (\m :: Add
m@(Add ProcessId
_ Double
_ Double
_) -> ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
s Add
m)
testMatchAnyNoHandle :: TestTransport -> Assertion
testMatchAnyNoHandle :: TestTransport -> Assertion
testMatchAnyNoHandle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
addr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
serverDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ 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
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(Add -> Bool) -> (Message -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (Message -> Process b) -> Match b
matchAnyIf
(\(Add ProcessId
_ Double
_ Double
_) -> Bool
True)
(\Message
m -> do
Maybe Any
r <- (Message -> (String -> Process Any) -> Process (Maybe Any)
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String) -> String -> Process Any
forall a b. Serializable a => a -> Process b
die String
"NONSENSE" ))
case Maybe Any
r of
Maybe Any
Nothing -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Any
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"NONSENSE")
]
Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
100000 [ (Add -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(Add ProcessId
_ Double
_ Double
_) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ do
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected timeout!" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ()
res Maybe () -> Maybe () -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ()
forall a. Maybe a
Nothing
MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
serverDone ()
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
addr ProcessId
server
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
addr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> Add -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId -> Double -> Double -> Add
Add ProcessId
pid Double
1 Double
2)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
serverDone
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar (String, Maybe String, String)
clientDone <- IO (MVar (String, Maybe String, String))
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
echoServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ Process (Maybe ()) -> Process ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Process (Maybe ()) -> Process ())
-> Process (Maybe ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ do
[Match (Maybe ())] -> Process (Maybe ())
forall b. [Match b] -> Process b
receiveWait [
((ProcessId, String) -> Bool)
-> (Message -> Process (Maybe ())) -> Match (Maybe ())
forall a b.
Serializable a =>
(a -> Bool) -> (Message -> Process b) -> Match b
matchAnyIf (\(ProcessId
_ :: ProcessId, (String
s :: String)) -> String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"bar")
Message -> Process (Maybe ())
tryHandleMessage
]
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
echoAddr ProcessId
echoServer
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
echoAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"foo")
String
foo <- Process String
forall a. Serializable a => Process a
expect
ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"bar")
Maybe String
bar <- (Int -> Process (Maybe String)
forall a. Serializable a => Int -> Process (Maybe a)
expectTimeout Int
100000) :: Process (Maybe String)
ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String
"baz")
String
baz <- Process String
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (String, Maybe String, String)
-> (String, Maybe String, String) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (String, Maybe String, String)
clientDone (String
foo, Maybe String
bar, String
baz)
(String, Maybe String, String)
res <- MVar (String, Maybe String, String)
-> IO (String, Maybe String, String)
forall a. MVar a -> IO a
takeMVar MVar (String, Maybe String, String)
clientDone
let res' :: Bool
res' = (String, Maybe String, String)
res (String, Maybe String, String)
-> (String, Maybe String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foo", Maybe String
forall a. Maybe a
Nothing, String
"baz")
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected timeout due to type mismatch" Bool
res'
where tryHandleMessage :: Message -> Process (Maybe ())
tryHandleMessage :: Message -> Process (Maybe ())
tryHandleMessage Message
msg =
Message
-> ((ProcessId, String) -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
msg (\(ProcessId
pid :: ProcessId, (String
m :: String))
-> do { ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid String
m; () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return () })
testMatchMessageWithUnwrap :: TestTransport -> Assertion
testMatchMessageWithUnwrap :: TestTransport -> Assertion
testMatchMessageWithUnwrap TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar (String, String)
clientDone <- IO (MVar (String, String))
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
echoServer <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ 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
Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [
(Message -> Process Message) -> Match Message
matchMessage (\(Message
m :: Message) -> do
Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
m)
]
Maybe (ProcessId, Message)
unwrapped <- Message -> Process (Maybe (ProcessId, Message))
forall (m :: * -> *) a.
(Monad m, Serializable a) =>
Message -> m (Maybe a)
unwrapMessage Message
msg :: Process (Maybe (ProcessId, Message))
case Maybe (ProcessId, Message)
unwrapped of
(Just (ProcessId
p, Message
msg')) -> Message -> ProcessId -> Process ()
forward Message
msg' ProcessId
p
Maybe (ProcessId, Message)
Nothing -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"unable to unwrap the message"
MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
echoAddr ProcessId
echoServer
Assertion -> IO ThreadId
forkIO (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
server <- MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
readMVar MVar ProcessId
echoAddr
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process ProcessId
getSelfPid
ProcessId -> (ProcessId, Message) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String -> Message
forall a. Serializable a => a -> Message
wrapMessage (String
"foo" :: String))
String
foo <- Process String
forall a. Serializable a => Process a
expect
ProcessId -> (ProcessId, Message) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
server (ProcessId
pid, String -> Message
forall a. Serializable a => a -> Message
wrapMessage (String
"baz" :: String))
String
baz <- Process String
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (String, String) -> (String, String) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (String, String)
clientDone (String
foo, String
baz)
(String, String)
res <- MVar (String, String) -> IO (String, String)
forall a. MVar a -> IO a
takeMVar MVar (String, String)
clientDone
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected unwrapped results" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ (String, String)
res (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foo", String
"baz")
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
mvSender <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar (SendPort Bool)
sendPort <- IO (MVar (SendPort Bool))
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
(SendPort Bool
sp, ReceivePort Bool
rp) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Bool, ReceivePort Bool)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort Bool) -> SendPort Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort Bool)
sendPort SendPort Bool
sp
Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
100000 ReceivePort Bool
rp Process (Maybe Bool) -> (Maybe Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Bool -> Process ()) -> Maybe Bool -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Process () -> Bool -> Process ()
forall a b. a -> b -> a
const (Process () -> Bool -> Process ())
-> Process () -> Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Timeout")
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
mvSender ()
Bool
res <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
20000000 ReceivePort Bool
rp Process (Maybe Bool)
-> (Maybe Bool -> Process Bool) -> Process Bool
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process Bool
-> (Bool -> Process Bool) -> Maybe Bool -> Process Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Process Bool
forall a b. Serializable a => a -> Process b
die String
"Timeout") Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected result to be 'True'" Bool
res
Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
rp Process (Maybe Bool) -> (Maybe Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Bool -> Process ()) -> Maybe Bool -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Process () -> Bool -> Process ()
forall a b. a -> b -> a
const (Process () -> Bool -> Process ())
-> Process () -> Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Timeout")
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
mvSender ()
(Process () -> Process ()) -> Process ()
forall a. (a -> a) -> a
fix ((Process () -> Process ()) -> Process ())
-> (Process () -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \Process ()
loop -> do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
Maybe Bool
mb <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
rp
case Maybe Bool
mb of
Just Bool
b -> do Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Unexpected Message" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b
Maybe Bool
_ -> Process ()
loop
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
SendPort Bool
sp <- IO (SendPort Bool) -> Process (SendPort Bool)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort Bool) -> Process (SendPort Bool))
-> IO (SendPort Bool) -> Process (SendPort Bool)
forall a b. (a -> b) -> a -> b
$ MVar (SendPort Bool) -> IO (SendPort Bool)
forall a. MVar a -> IO a
readMVar MVar (SendPort Bool)
sendPort
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
mvSender
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
100000
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
sp Bool
True
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
mvSender
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
sp Bool
False
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
Assertion -> IO ThreadId
forkTry (Assertion -> IO ThreadId) -> Assertion -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
(SendPort Int
spInt, ReceivePort Int
rpInt) <- Process (SendPort Int, ReceivePort Int)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Int, ReceivePort Int)
(SendPort Bool
spBool, ReceivePort Bool
rpBool) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Bool, ReceivePort Bool)
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
2
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
False
ReceivePort Bool
rp1 <- [ReceivePort Bool] -> Process (ReceivePort Bool)
forall a.
Serializable a =>
[ReceivePort a] -> Process (ReceivePort a)
mergePortsBiased [Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> ReceivePort Int -> ReceivePort Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReceivePort Int
rpInt, ReceivePort Bool
rpBool]
ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected True"
ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False" (Bool -> Assertion) -> (Bool -> Bool) -> Bool -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
3
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
4
let rp2 :: ReceivePort Int
rp2 = (Int -> Int -> Int) -> ReceivePort (Int -> Int -> Int)
forall a. a -> ReceivePort a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ReceivePort (Int -> Int -> Int)
-> ReceivePort Int -> ReceivePort (Int -> Int)
forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReceivePort Int
rpInt ReceivePort (Int -> Int) -> ReceivePort Int -> ReceivePort Int
forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReceivePort Int
rpInt
ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp2 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 7" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7)
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
3
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
True
let rp3 :: ReceivePort Bool
rp3 = (Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> ReceivePort Int -> ReceivePort Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReceivePort Int
rpInt) ReceivePort Bool -> ReceivePort Bool -> ReceivePort Bool
forall a. ReceivePort a -> ReceivePort a -> ReceivePort a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReceivePort Bool
rpBool
ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected False" (Bool -> Assertion) -> (Bool -> Bool) -> Bool -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3 Process Bool -> (Bool -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Bool -> Assertion) -> Bool -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected True"
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
True
SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
spBool Bool
False
SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
spInt Int
5
let rp4 :: ReceivePort Int
rp4 :: ReceivePort Int
rp4 = do Bool
b <- ReceivePort Bool
rpBool
if Bool
b
then ReceivePort Int
rpInt
else Int -> ReceivePort Int
forall a. a -> ReceivePort a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
7
ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 5" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5)
ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4 Process Int -> (Int -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Int -> Assertion) -> Int -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 7" (Bool -> Assertion) -> (Int -> Bool) -> Int -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testChanLifecycle :: TestTransport -> Assertion
testChanLifecycle :: TestTransport -> Assertion
testChanLifecycle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = let delay :: Int
delay = Int
3000000 in do
MVar Bool
result <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
MVar (SendPort (), ReceivePort ())
tchMV <- IO (MVar (SendPort (), ReceivePort ()))
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do (SendPort (), ReceivePort ())
tCh <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> (SendPort (), ReceivePort ()) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (), ReceivePort ())
tchMV (SendPort (), ReceivePort ())
tCh
Process ()
forall a. Serializable a => Process a
expect :: Process ()
let (SendPort ()
sp, ReceivePort ()
_) = (SendPort (), ReceivePort ())
tCh
SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sp ()
Process ()
forall a. Serializable a => Process a
expect :: Process ()
MonitorRef
mRefPid <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId
cPid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
(SendPort ()
sp', ReceivePort ()
rp) <- IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ()))
-> IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> IO (SendPort (), ReceivePort ())
forall a. MVar a -> IO a
takeMVar MVar (SendPort (), ReceivePort ())
tchMV
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
Maybe ()
res <- Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort ()
rp
case Maybe ()
res of
Maybe ()
Nothing -> String -> Process ()
say String
"initial chan () missing!" Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result Bool
False)
Just () -> do MonitorRef
_ <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
Int -> Process ()
pause Int
10000
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [ (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(ProcessMonitorNotification
_ :: ProcessMonitorNotification) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> (SendPort (), ReceivePort ()) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (SendPort (), ReceivePort ())
tchMV (SendPort ()
sp', ReceivePort ()
rp)
Maybe ()
recv <- Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort ()
rp
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ()
recv
MonitorRef
mRefCPid <- ProcessId -> Process MonitorRef
monitor ProcessId
cPid
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
[ (ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(ProcessMonitorNotification MonitorRef
r ProcessId
_ DiedReason
_) -> MonitorRef
r MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
mRefPid)
(\ProcessMonitorNotification
_ -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
(SendPort ()
sendPort, ReceivePort ()
_) <- IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ()))
-> IO (SendPort (), ReceivePort ())
-> Process (SendPort (), ReceivePort ())
forall a b. (a -> b) -> a -> b
$ MVar (SendPort (), ReceivePort ())
-> IO (SendPort (), ReceivePort ())
forall a. MVar a -> IO a
takeMVar MVar (SendPort (), ReceivePort ())
tchMV
SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sendPort ()
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
cPid ()
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait
[ (ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(ProcessMonitorNotification MonitorRef
r ProcessId
_ DiedReason
_) -> MonitorRef
r MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
mRefCPid)
(\ProcessMonitorNotification
_ -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
Bool
testRes <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected sending on the channel to fail, but received data!" Bool
testRes
testKillLocal :: TestTransport -> Assertion
testKillLocal :: TestTransport -> Assertion
testKillLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
1000000
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId
us <- Process ProcessId
getSelfPid
ProcessId -> String -> Process ()
kill ProcessId
pid String
"TestKill"
ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
case ProcessMonitorNotification
mn of
ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' (DiedException String
ex) ->
case MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid' Bool -> Bool -> Bool
&& String
ex String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"killed-by=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",reason=TestKill" of
Bool
True -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Invalid ProcessMonitorNotification received"
ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
testKillRemote :: TestTransport -> Assertion
testKillRemote :: TestTransport -> Assertion
testKillRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Assertion
threadDelay Int
1000000
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId
us <- Process ProcessId
getSelfPid
ProcessId -> String -> Process ()
kill ProcessId
pid String
"TestKill"
ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
case ProcessMonitorNotification
mn of
ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' (DiedException String
reason) ->
case (MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref', ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid', String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"killed-by=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",reason=TestKill") of
(Bool
True, Bool
True, Bool
True) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool
a, Bool
b, Bool
c) -> do
let a' :: String
a' = if Bool
a then String
"" else String
"Invalid ref"
let b' :: String
b' = if Bool
b then String
"" else String
"Invalid pid"
let c' :: String
c' = if Bool
c then String
"" else String
"Invalid message"
String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
a', String
b', String
c']
ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Received unexpected message"
testCatchesExit :: TestTransport -> Assertion
testCatchesExit :: TestTransport -> Assertion
testCatchesExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
((String, Int) -> Process ()
forall a b. Serializable a => a -> Process b
die (String
"foobar", Int
123 :: Int))
Process ()
-> [ProcessId -> Message -> Process (Maybe ())] -> Process ()
forall b.
Process b
-> [ProcessId -> Message -> Process (Maybe b)] -> Process b
`catchesExit` [
(\ProcessId
_ Message
m -> Message -> (String -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
, (\ProcessId
_ Message
m -> Message -> (Maybe Int -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(Maybe Int
_ :: Maybe Int) -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
, (\ProcessId
_ Message
m -> Message -> ((String, Int) -> Process ()) -> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(String
_ :: String, Int
_ :: Int)
-> (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()) Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
]
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testHandleMessageIf :: TestTransport -> Assertion
testHandleMessageIf :: TestTransport -> Assertion
testHandleMessageIf TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar (Integer, Integer)
done <- IO (MVar (Integer, Integer))
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
self <- Process ProcessId
getSelfPid
ProcessId -> (Integer, Integer) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
self (Integer
5 :: Integer, Integer
10 :: Integer)
Message
msg <- [Match Message] -> Process Message
forall b. [Match b] -> Process b
receiveWait [ (Message -> Process Message) -> Match Message
matchMessage Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
Message
-> (() -> Bool) -> (() -> Process Any) -> Process (Maybe Any)
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> Bool) -> (a -> m b) -> m (Maybe b)
handleMessageIf Message
msg
(\() -> Bool
True)
(\() -> String -> Process Any
forall a b. Serializable a => a -> Process b
die String
"whoops") Process (Maybe Any) -> (Maybe Any -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> (Any -> Process ()) -> Maybe Any -> Process ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(Process () -> Any -> Process ()
forall a b. a -> b -> a
const (Process () -> Any -> Process ())
-> Process () -> Any -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Expected Mismatch")
Message
-> ((Integer, Integer) -> Bool)
-> ((Integer, Integer) -> Process ())
-> Process (Maybe ())
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> Bool) -> (a -> m b) -> m (Maybe b)
handleMessageIf Message
msg (\(Integer
x :: Integer, Integer
y :: Integer) -> Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
5 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
10)
(\(Integer, Integer)
input -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar (Integer, Integer) -> (Integer, Integer) -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Integer, Integer)
done (Integer, Integer)
input)
() -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Integer, Integer)
result <- MVar (Integer, Integer) -> IO (Integer, Integer)
forall a. MVar a -> IO a
takeMVar MVar (Integer, Integer)
done
(Integer, Integer) -> Matcher (Integer, Integer) -> Assertion
forall a. a -> Matcher a -> Assertion
expectThat (Integer, Integer)
result (Matcher (Integer, Integer) -> Assertion)
-> Matcher (Integer, Integer) -> Assertion
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> Matcher (Integer, Integer)
forall a. (Show a, Eq a) => a -> Matcher a
equalTo (Integer
5, Integer
10)
testCatches :: TestTransport -> Assertion
testCatches :: TestTransport -> Assertion
testCatches TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
NodeId
node <- Process NodeId
getSelfNode
(Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ ProcessLinkException -> Assertion
forall e a. Exception e => e -> IO a
throwIO (ProcessId -> DiedReason -> ProcessLinkException
ProcessLinkException (NodeId -> ProcessId
nullProcessId NodeId
node) DiedReason
DiedNormal))
Process () -> [Handler ()] -> Process ()
forall a. Process a -> [Handler a] -> Process a
`catches` [
(ProcessLinkException -> Process ()) -> Handler ()
forall a e. Exception e => (e -> Process a) -> Handler a
Handler (\(ProcessLinkException ProcessId
_ DiedReason
_) -> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ())
]
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testMaskRestoreScope :: TestTransport -> Assertion
testMaskRestoreScope :: TestTransport -> Assertion
testMaskRestoreScope TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ProcessId
parentPid <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar ProcessId)
MVar ProcessId
spawnedPid <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar ProcessId)
Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall b.
HasCallStack =>
((forall a. Process a -> Process a) -> Process b) -> Process b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. Process a -> Process a) -> Process ()) -> Process ())
-> ((forall a. Process a -> Process a) -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \forall a. Process a -> Process a
unmask -> do
Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
parentPid
Process ProcessId -> Process ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Process ProcessId -> Process ())
-> Process ProcessId -> Process ()
forall a b. (a -> b) -> a -> b
$ Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ Process () -> Process ()
forall a. Process a -> Process a
unmask (Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (ProcessId -> Assertion) -> ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
spawnedPid)
ProcessId
parent <- IO ProcessId -> IO ProcessId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> IO ProcessId) -> IO ProcessId -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
parentPid
ProcessId
child <- IO ProcessId -> IO ProcessId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> IO ProcessId) -> IO ProcessId -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
spawnedPid
ProcessId -> Matcher ProcessId -> Assertion
forall a. a -> Matcher a -> Assertion
expectThat ProcessId
parent (Matcher ProcessId -> Assertion) -> Matcher ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ Matcher ProcessId -> Matcher ProcessId
forall a. Matcher a -> Matcher a
isNot (Matcher ProcessId -> Matcher ProcessId)
-> Matcher ProcessId -> Matcher ProcessId
forall a b. (a -> b) -> a -> b
$ ProcessId -> Matcher ProcessId
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ProcessId
child
testDie :: TestTransport -> Assertion
testDie :: TestTransport -> Assertion
testDie TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
((String, Int) -> Process ()
forall a b. Serializable a => a -> Process b
die (String
"foobar", Int
123 :: Int))
Process ()
-> (ProcessId -> (String, Int) -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from (String, Int)
reason -> do
let res :: Bool
res = (String, Int)
reason (String, Int) -> (String, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"foobar", Int
123 :: Int)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
if Bool
res
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testPrettyExit :: TestTransport -> Assertion
testPrettyExit :: TestTransport -> Assertion
testPrettyExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
done <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
(String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"timeout")
Process () -> (ProcessExitException -> Process ()) -> Process ()
forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \ex :: ProcessExitException
ex@(ProcessExitException ProcessId
from Message
_) ->
let expected :: String
expected = String
"exit-from=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
from)
in do
let res :: Bool
res = (ProcessExitException -> String
forall a. Show a => a -> String
show ProcessExitException
ex) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()
if Bool
res
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done
testExitLocal :: TestTransport -> Assertion
testExitLocal :: TestTransport -> Assertion
testExitLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
supervisedDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
supervisorDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
handlerSetUp <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
(Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
handlerSetUp ()) Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Process ()
forall a. Serializable a => Process a
expect) Process () -> (ProcessId -> String -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from String
reason -> do
Bool
res <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TestExit"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisedDone ()
if Bool
res
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
handlerSetUp
MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
pid String
"TestExit"
ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
case ProcessMonitorNotification
mn of
ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal -> do
let res :: Bool
res = MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid'
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisorDone ()
if Bool
res
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisedDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisorDone
testExitRemote :: TestTransport -> Assertion
testExitRemote :: TestTransport -> Assertion
testExitRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar ()
supervisedDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
supervisorDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
([Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [] :: Process ())
Process () -> (ProcessId -> String -> Process ()) -> Process ()
forall a b.
(Show a, Serializable a) =>
Process b -> (ProcessId -> a -> Process b) -> Process b
`catchExit` \ProcessId
_from String
reason -> do
Bool
res <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ String
reason String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TestExit"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisedDone ()
if Bool
res
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
pid String
"TestExit"
ProcessMonitorNotification
mn <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
case ProcessMonitorNotification
mn of
ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal -> do
Bool
res' <- Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Process Bool) -> Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref' Bool -> Bool -> Bool
&& ProcessId
pid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid'
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
supervisorDone ()
if Bool
res'
then () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
ProcessMonitorNotification
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Something went horribly wrong"
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisedDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisorDone
testRegistryMonitoring :: TestTransport -> Assertion
testRegistryMonitoring :: TestTransport -> Assertion
testRegistryMonitoring TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
let nid :: NodeId
nid = LocalNode -> NodeId
localNodeId LocalNode
node2
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
self <- Process ProcessId
getSelfPid
NodeId -> ProcessId -> Process ()
runUntilRegistered NodeId
nid ProcessId
self
String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
self) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" registered as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
regName
Process ()
forall a. Serializable a => Process a
expect :: Process ()
String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
self) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" exiting normally"
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
String -> ProcessId -> Process ()
register String
regName ProcessId
pid
String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
regName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" registered to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid
Maybe ProcessId
res <- String -> Process (Maybe ProcessId)
whereis String
regName
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
String -> Process ()
say (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
" sent finish signal to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid
ProcessId
_ <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"expected (Just pid)" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Maybe ProcessId
res Maybe ProcessId -> Maybe ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
pid)
Process (Maybe Message) -> Process ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Process (Maybe Message) -> Process ())
-> Process (Maybe Message) -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> [Match Message] -> Process (Maybe Message)
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
4000000 [ (Message -> Process Message) -> Match Message
forall b. (Message -> Process b) -> Match b
matchAny Message -> Process Message
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ NodeId -> ProcessId -> Process ()
forall {t}. NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid ProcessId
pid
MVar (Maybe ProcessId)
regHere <- IO (MVar (Maybe ProcessId))
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ String -> Process (Maybe ProcessId)
whereis String
regName Process (Maybe ProcessId)
-> (Maybe ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ())
-> (Maybe ProcessId -> Assertion) -> Maybe ProcessId -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe ProcessId) -> Maybe ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar (Maybe ProcessId)
regHere
Maybe ProcessId
res <- MVar (Maybe ProcessId) -> IO (Maybe ProcessId)
forall a. MVar a -> IO a
takeMVar MVar (Maybe ProcessId)
regHere
case Maybe ProcessId
res of
Maybe ProcessId
Nothing -> () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ProcessId
_ -> HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
"expected Nothing, but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid) Bool
False
where
runUntilRegistered :: NodeId -> ProcessId -> Process ()
runUntilRegistered NodeId
nid ProcessId
us = do
NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
regName
[Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
(WhereIsReply -> Bool) -> (WhereIsReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(WhereIsReply String
n (Just ProcessId
p)) -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
regName Bool -> Bool -> Bool
&& ProcessId
p ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us)
(Process () -> WhereIsReply -> Process ()
forall a b. a -> b -> a
const (Process () -> WhereIsReply -> Process ())
-> Process () -> WhereIsReply -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
delayUntilMaybeUnregistered :: NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid t
p = do
NodeId -> String -> Process ()
whereisRemoteAsync NodeId
nid String
regName
Maybe ()
res <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
20000000 [
(WhereIsReply -> Bool) -> (WhereIsReply -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(WhereIsReply String
n Maybe ProcessId
p') -> String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
regName Bool -> Bool -> Bool
&& Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProcessId
p')
(Process () -> WhereIsReply -> Process ()
forall a b. a -> b -> a
const (Process () -> WhereIsReply -> Process ())
-> Process () -> WhereIsReply -> Process ()
forall a b. (a -> b) -> a -> b
$ () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
case Maybe ()
res of
Just () -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ()
Nothing -> NodeId -> t -> Process ()
delayUntilMaybeUnregistered NodeId
nid t
p
regName :: String
regName = String
"testRegisterRemote"
testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
self <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
ProcessId
clientAddr <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
clientAddr ()
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
serverPid
Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
self <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
ProcessId
clientAddr <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeUSend ProcessId
clientAddr ()
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeUSend ProcessId
serverPid
Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
pid <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone
Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
String -> ProcessId -> Process ()
register String
"foobar" ProcessId
pid
String -> () -> Process ()
forall a. Serializable a => String -> a -> Process ()
unsafeNSend String
"foobar" ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testUnsafeNSendRemote :: TestTransport -> Assertion
testUnsafeNSendRemote :: TestTransport -> Assertion
testUnsafeNSendRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
localNode2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
_ <- LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode1 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ProcessId -> Process ()
register String
"foobar"
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()
Process ()
forall a. Serializable a => Process a
expect Process () -> (() -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> (() -> Assertion) -> () -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
Assertion -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode2 (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
NodeId -> String -> () -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
unsafeNSendRemote (LocalNode -> NodeId
localNodeId LocalNode
localNode1) String
"foobar" ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testUnsafeSendChan :: TestTransport -> Assertion
testUnsafeSendChan :: TestTransport -> Assertion
testUnsafeSendChan TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
LocalNode
localNode <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
self <- Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> ProcessId -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ProcessId
serverAddr ProcessId
self
SendPort ()
sp <- Process (SendPort ())
forall a. Serializable a => Process a
expect
SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
unsafeSendChan SendPort ()
sp ()
IO ProcessId -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessId -> Assertion) -> IO ProcessId -> Assertion
forall a b. (a -> b) -> a -> b
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
localNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
serverPid <- IO ProcessId -> Process ProcessId
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessId -> Process ProcessId)
-> IO ProcessId -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> IO ProcessId
forall a. MVar a -> IO a
takeMVar MVar ProcessId
serverAddr
(SendPort ()
sp, ReceivePort ()
rp) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId -> SendPort () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
unsafeSend ProcessId
serverPid SendPort ()
sp
ReceivePort () -> Process ()
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ()
rp :: Process ()
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()
MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
testCallLocal :: TestTransport -> Assertion
testCallLocal :: TestTransport -> Assertion
testCallLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
MVar Bool
result <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
Bool
r <- ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (ProcessId -> ProcessId -> Bool)
-> Process ProcessId -> Process (ProcessId -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process ProcessId
getSelfPid Process (ProcessId -> Bool) -> Process ProcessId -> Process Bool
forall a b. Process (a -> b) -> Process a -> Process b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Process ProcessId -> Process ProcessId
forall a. Process a -> Process a
callLocal Process ProcessId
getSelfPid
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result Bool
r
MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
IORef Bool
ibox <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
keeper <- Process ProcessId
getSelfPid
Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
caller <- Process ProcessId
getSelfPid
ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onException
(Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onException (do ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
Process ()
forall a. Serializable a => Process a
expect)
(do Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox Bool
True))
(ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ())
ProcessId
caller <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
caller String
"test"
Process ()
forall a. Serializable a => Process a
expect :: Process ()
IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
IORef Bool
ibox2 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
Either ErrorCall ()
r <- Process () -> Process (Either ErrorCall ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process Any
forall a. HasCallStack => String -> a
error String
"e" Process Any -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox2 (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ case Either ErrorCall ()
r of
Left (ErrorCall String
"e") -> Bool
True
Either ErrorCall ()
_ -> Bool
False
IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
IORef Bool
ibox3 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
MVar Bool
result3 <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
keeper <- Process ProcessId
getSelfPid
Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
Process () -> Process ()
forall a. Process a -> Process a
callLocal (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
(do ProcessId
us <- Process ProcessId
getSelfPid
ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
us
() <- Process ()
forall a. Serializable a => Process a
expect
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Assertion
yield)
Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox3 Bool
True)
Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result3 (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox3
ProcessId
worker <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
worker ()
MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result3 IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
IORef Bool
ibox4 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
MVar Bool
result4 <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
LocalNode -> Process () -> Assertion
runProcess LocalNode
node (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
ProcessId
keeper <- Process ProcessId
getSelfPid
Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId
caller <- Process ProcessId
getSelfPid
Process () -> Process ()
forall a. Process a -> Process a
callLocal
((do ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
keeper ProcessId
caller
Process ()
forall a. Serializable a => Process a
expect)
Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> Assertion
forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
ibox4 Bool
True))
Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` (Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Process ()) -> Assertion -> Process ()
forall a b. (a -> b) -> a -> b
$ MVar Bool -> Bool -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar Bool
result4 (Bool -> Assertion) -> IO Bool -> Assertion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox4)
ProcessId
caller <- Process ProcessId
forall a. Serializable a => Process a
expect
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
exit ProcessId
caller String
"hi!"
MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result4 IO Bool -> (Bool -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"Expected 'True'"
tests :: TestTransport -> IO [Test]
tests :: TestTransport -> IO [Test]
tests TestTransport
testtrans = [Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [
String -> [Test] -> Test
testGroup String
"Basic features" [
String -> Assertion -> Test
testCase String
"Ping" (TestTransport -> Assertion
testPing TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Math" (TestTransport -> Assertion
testMath TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Timeout" (TestTransport -> Assertion
testTimeout TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Timeout0" (TestTransport -> Assertion
testTimeout0 TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"SendToTerminated" (TestTransport -> Assertion
testSendToTerminated TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TypedChannnels" (TestTransport -> Assertion
testTypedChannels TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Terminate" (TestTransport -> Assertion
testTerminate TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"RegistryRemoteProcess" (TestTransport -> Assertion
testRegistryRemoteProcess TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"RemoteRegistry" (TestTransport -> Assertion
testRemoteRegistry TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"RemoteRegistryRemoteProcess" (TestTransport -> Assertion
testRemoteRegistryRemoteProcess TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"SpawnLocal" (TestTransport -> Assertion
testSpawnLocal TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"SpawnAsyncStrictness" (TestTransport -> Assertion
testSpawnAsyncStrictness TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"HandleMessageIf" (TestTransport -> Assertion
testHandleMessageIf TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MatchAny" (TestTransport -> Assertion
testMatchAny TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MatchAnyHandle" (TestTransport -> Assertion
testMatchAnyHandle TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MatchAnyNoHandle" (TestTransport -> Assertion
testMatchAnyNoHandle TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MatchAnyIf" (TestTransport -> Assertion
testMatchAnyIf TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MatchMessageUnwrap" (TestTransport -> Assertion
testMatchMessageWithUnwrap TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"ReceiveChanTimeout" (TestTransport -> Assertion
testReceiveChanTimeout TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"ReceiveChanFeatures" (TestTransport -> Assertion
testReceiveChanFeatures TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"ChanLifecycle" (TestTransport -> Assertion
testChanLifecycle TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"KillLocal" (TestTransport -> Assertion
testKillLocal TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"KillRemote" (TestTransport -> Assertion
testKillRemote TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Die" (TestTransport -> Assertion
testDie TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"PrettyExit" (TestTransport -> Assertion
testPrettyExit TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"CatchesExit" (TestTransport -> Assertion
testCatchesExit TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Catches" (TestTransport -> Assertion
testCatches TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MaskRestoreScope" (TestTransport -> Assertion
testMaskRestoreScope TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"ExitLocal" (TestTransport -> Assertion
testExitLocal TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"ExitRemote" (TestTransport -> Assertion
testExitRemote TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"RegistryMonitoring" (TestTransport -> Assertion
testRegistryMonitoring TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TextCallLocal" (TestTransport -> Assertion
testCallLocal TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TestUnsafeSend" (TestTransport -> Assertion
testUnsafeSend TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TestUnsafeUSend" (TestTransport -> Assertion
testUnsafeUSend TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TestUnsafeNSend" (TestTransport -> Assertion
testUnsafeNSend TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TestUnsafeNSendRemote" (TestTransport -> Assertion
testUnsafeNSendRemote TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"TestUnsafeSendChan" (TestTransport -> Assertion
testUnsafeSendChan TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"USend" ((ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend ProcessId -> Int -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
usend TestTransport
testtrans Int
50)
, String -> Assertion -> Test
testCase String
"UForward"
((ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend (\ProcessId
p Int
m -> Message -> ProcessId -> Process ()
uforward (Int -> Message
forall a. Serializable a => a -> Message
createUnencodedMessage Int
m) ProcessId
p)
TestTransport
testtrans Int
50
)
]
, String -> [Test] -> Test
testGroup String
"Monitoring and Linking" [
String -> Assertion -> Test
testCase String
"MonitorNormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport
testtrans Bool
True Bool
False)
, String -> Assertion -> Test
testCase String
"MonitorAbnormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
True Bool
False)
, String -> Assertion -> Test
testCase String
"MonitorLocalDeadProcess" (TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess TestTransport
testtrans Bool
True Bool
False)
, String -> Assertion -> Test
testCase String
"MonitorRemoteDeadProcess" (TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess TestTransport
testtrans Bool
True Bool
False)
, String -> Assertion -> Test
testCase String
"MonitorDisconnect" (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport
testtrans Bool
True Bool
False)
, String -> Assertion -> Test
testCase String
"LinkUnreachable" (TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"LinkNormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"LinkAbnormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"LinkLocalDeadProcess" (TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"LinkRemoteDeadProcess" (TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"LinkDisconnect" (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport
testtrans Bool
False Bool
False)
, String -> Assertion -> Test
testCase String
"UnmonitorNormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport
testtrans Bool
True Bool
True)
, String -> Assertion -> Test
testCase String
"UnmonitorAbnormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
True Bool
True)
, String -> Assertion -> Test
testCase String
"UnmonitorDisconnect" (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport
testtrans Bool
True Bool
True)
, String -> Assertion -> Test
testCase String
"UnlinkNormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport
testtrans Bool
False Bool
True)
, String -> Assertion -> Test
testCase String
"UnlinkAbnormalTermination" (TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport
testtrans Bool
False Bool
True)
, String -> Assertion -> Test
testCase String
"UnlinkDisconnect" (TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport
testtrans Bool
False Bool
True)
, String -> Assertion -> Test
testCase String
"MonitorNode" (TestTransport -> Assertion
testMonitorNode TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MonitorLiveNode" (TestTransport -> Assertion
testMonitorLiveNode TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MonitorChannel" (TestTransport -> Assertion
testMonitorChannel TestTransport
testtrans)
]
, String -> [Test] -> Test
testGroup String
"Flaky" [
String -> Assertion -> Test
testCase String
"Reconnect" (TestTransport -> Assertion
testReconnect TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"Registry" (TestTransport -> Assertion
testRegistry TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MergeChannels" (TestTransport -> Assertion
testMergeChannels TestTransport
testtrans)
, String -> Assertion -> Test
testCase String
"MonitorUnreachable" (TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport
testtrans Bool
True Bool
False)
]
]