{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ParallelListComp #-}
module Control.Distributed.Process.Tests.Mx (tests) where
import Control.Distributed.Process.Tests.Internal.Utils
import Network.Transport.Test (TestTransport(..))
import Control.Distributed.Process hiding (bracket, finally, try)
import Control.Distributed.Process.Internal.Types
( ProcessExitException(..)
, unsafeCreateUnencodedMessage
)
import Control.Distributed.Process.Node
import qualified Control.Distributed.Process.UnsafePrimitives as Unsafe
( send
, nsend
, nsendRemote
, usend
, sendChan
)
import Control.Distributed.Process.Management
( MxEvent(..)
, MxAgentId(..)
, mxAgent
, mxSink
, mxReady
, mxReceive
, mxDeactivate
, liftMX
, mxGetLocal
, mxSetLocal
, mxUpdateLocal
, mxNotify
, mxBroadcast
)
import Control.Monad (void, unless)
import Control.Monad.Catch(finally, bracket, try)
import Control.Rematch (equalTo)
import Data.Binary
import Data.List (find, sort, intercalate)
import Data.Maybe (isJust, fromJust, isNothing, fromMaybe, catMaybes)
import Data.Typeable
import GHC.Generics hiding (from)
#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch, log)
#endif
import Test.Framework
( Test
, testGroup
)
import Test.Framework.Providers.HUnit (testCase)
data Publish = Publish
deriving (Typeable, (forall x. Publish -> Rep Publish x)
-> (forall x. Rep Publish x -> Publish) -> Generic Publish
forall x. Rep Publish x -> Publish
forall x. Publish -> Rep Publish x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Publish -> Rep Publish x
from :: forall x. Publish -> Rep Publish x
$cto :: forall x. Rep Publish x -> Publish
to :: forall x. Rep Publish x -> Publish
Generic, Publish -> Publish -> Bool
(Publish -> Publish -> Bool)
-> (Publish -> Publish -> Bool) -> Eq Publish
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Publish -> Publish -> Bool
== :: Publish -> Publish -> Bool
$c/= :: Publish -> Publish -> Bool
/= :: Publish -> Publish -> Bool
Eq)
instance Binary Publish where
awaitExit :: ProcessId -> Process ()
awaitExit :: ProcessId -> Process ()
awaitExit ProcessId
pid =
ProcessId -> (MonitorRef -> Process ()) -> Process ()
forall {b}. ProcessId -> (MonitorRef -> Process b) -> Process b
withMonitorRef ProcessId
pid ((MonitorRef -> Process ()) -> Process ())
-> (MonitorRef -> Process ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \MonitorRef
ref -> do
[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
ref)
(\ProcessMonitorNotification
_ -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
]
where
withMonitorRef :: ProcessId -> (MonitorRef -> Process b) -> Process b
withMonitorRef ProcessId
p = Process MonitorRef
-> (MonitorRef -> Process ())
-> (MonitorRef -> Process b)
-> Process b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (ProcessId -> Process MonitorRef
monitor ProcessId
p) MonitorRef -> Process ()
unmonitor
testAgentBroadcast :: TestResult (Maybe ()) -> Process ()
testAgentBroadcast :: TestResult (Maybe ()) -> Process ()
testAgentBroadcast TestResult (Maybe ())
result = do
(SendPort ()
resultSP, ReceivePort ()
resultRP) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
ProcessId
publisher <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
"publisher-agent") () [
(() -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((() -> MxAgent () MxAction) -> MxSink ())
-> (() -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \() -> Publish -> MxAgent () ()
forall m s. Serializable m => m -> MxAgent s ()
mxBroadcast Publish
Publish MxAgent () () -> MxAgent () MxAction -> MxAgent () MxAction
forall a b. MxAgent () a -> MxAgent () b -> MxAgent () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
ProcessId
consumer <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
"consumer-agent") () [
(Publish -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((Publish -> MxAgent () MxAction) -> MxSink ())
-> (Publish -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \Publish
Publish -> (Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
resultSP ()) MxAgent () () -> MxAgent () MxAction -> MxAgent () MxAction
forall a b. MxAgent () a -> MxAgent () b -> MxAgent () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
() -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify ()
TestResult (Maybe ()) -> Maybe () -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult (Maybe ())
result (Maybe () -> Process ()) -> Process (Maybe ()) -> Process ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort ()
resultRP
ProcessId -> String -> Process ()
kill ProcessId
publisher String
"finished"
ProcessId -> String -> Process ()
kill ProcessId
consumer String
"finished"
testAgentDualInput :: TestResult (Maybe Int) -> Process ()
testAgentDualInput :: TestResult (Maybe Int) -> Process ()
testAgentDualInput TestResult (Maybe Int)
result = do
(SendPort Int
sp, ReceivePort Int
rp) <- Process (SendPort Int, ReceivePort Int)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
s <- MxAgentId -> Int -> [MxSink Int] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
"sum-agent") (Int
0 :: Int) [
(Int -> MxAgent Int MxAction) -> MxSink Int
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((Int -> MxAgent Int MxAction) -> MxSink Int)
-> (Int -> MxAgent Int MxAction) -> MxSink Int
forall a b. (a -> b) -> a -> b
$ (\(Int
i :: Int) -> do
Int -> MxAgent Int ()
forall s. s -> MxAgent s ()
mxSetLocal (Int -> MxAgent Int ()) -> (Int -> Int) -> Int -> MxAgent Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int -> MxAgent Int ()) -> MxAgent Int Int -> MxAgent Int ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MxAgent Int Int
forall s. MxAgent s s
mxGetLocal
Int
i' <- MxAgent Int Int
forall s. MxAgent s s
mxGetLocal
if Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
15
then do MxAgent Int Int
forall s. MxAgent s s
mxGetLocal MxAgent Int Int -> (Int -> MxAgent Int ()) -> MxAgent Int ()
forall a b. MxAgent Int a -> (a -> MxAgent Int b) -> MxAgent Int b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process () -> MxAgent Int ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent Int ())
-> (Int -> Process ()) -> Int -> MxAgent Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendPort Int -> Int -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Int
sp
String -> MxAgent Int MxAction
forall s. String -> MxAgent s MxAction
mxDeactivate String
"finished"
else MxAgent Int MxAction
forall s. MxAgent s MxAction
mxReady)
]
MonitorRef
mRef <- ProcessId -> Process MonitorRef
monitor ProcessId
s
Int -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify (Int
1 :: Int)
String -> Int -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"sum-agent" (Int
3 :: Int)
Int -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify (Int
2 :: Int)
String -> Int -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"sum-agent" (Int
4 :: Int)
Int -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify (Int
5 :: Int)
TestResult (Maybe Int) -> Maybe Int -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult (Maybe Int)
result (Maybe Int -> Process ()) -> Process (Maybe Int) -> Process ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReceivePort Int -> Process (Maybe Int)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort Int
rp
Maybe Bool
died <- Int -> [Match Bool] -> Process (Maybe Bool)
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
10000000 [
(ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process Bool) -> Match Bool
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
mRef) (Process Bool -> ProcessMonitorNotification -> Process Bool
forall a b. a -> b -> a
const (Process Bool -> ProcessMonitorNotification -> Process Bool)
-> Process Bool -> ProcessMonitorNotification -> Process Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
]
Maybe Bool
died Maybe Bool -> Matcher (Maybe Bool) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe Bool -> Matcher (Maybe Bool)
forall a. (Show a, Eq a) => a -> Matcher a
equalTo (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
testAgentPrioritisation :: TestResult [String] -> Process ()
testAgentPrioritisation :: TestResult [String] -> Process ()
testAgentPrioritisation TestResult [String]
result = do
let name :: String
name = String
"prioritising-agent"
(SendPort [String]
sp, ReceivePort [String]
rp) <- Process (SendPort [String], ReceivePort [String])
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
s <- MxAgentId -> [String] -> [MxSink [String]] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
name) [String
"first"] [
(String -> MxAgent [String] MxAction) -> MxSink [String]
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink (\(String
s :: String) -> do
([String] -> [String]) -> MxAgent [String] ()
forall s. (s -> s) -> MxAgent s ()
mxUpdateLocal (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
[String]
st <- MxAgent [String] [String]
forall s. MxAgent s s
mxGetLocal
case [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
st of
Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 -> do Process () -> MxAgent [String] ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent [String] ())
-> Process () -> MxAgent [String] ()
forall a b. (a -> b) -> a -> b
$ SendPort [String] -> [String] -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort [String]
sp ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
st)
String -> MxAgent [String] MxAction
forall s. String -> MxAgent s MxAction
mxDeactivate String
"finished"
Int
_ -> MxAgent [String] MxAction
forall s. MxAgent s MxAction
mxReceive
)
]
String -> String -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
name String
"second"
String -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify String
"third"
String -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify String
"fourth"
String -> String -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
name String
"fifth"
TestResult [String] -> [String] -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult [String]
result ([String] -> Process ())
-> (Maybe [String] -> [String]) -> Maybe [String] -> Process ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> Process ())
-> Process (Maybe [String]) -> Process ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReceivePort [String] -> Process (Maybe [String])
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort [String]
rp
ProcessId -> Process ()
awaitExit ProcessId
s
testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()
testAgentMailboxHandling :: TestResult (Maybe ()) -> Process ()
testAgentMailboxHandling TestResult (Maybe ())
result = do
(SendPort ()
sp, ReceivePort ()
rp) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
agent <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
"mailbox-agent") () [
(() -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((() -> MxAgent () MxAction) -> MxSink ())
-> (() -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \() -> (Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sp ()) MxAgent () () -> MxAgent () MxAction -> MxAgent () MxAction
forall a b. MxAgent () a -> MxAgent () b -> MxAgent () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
String -> () -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"mailbox-agent" ()
TestResult (Maybe ()) -> Maybe () -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult (Maybe ())
result (Maybe () -> Process ()) -> Process (Maybe ()) -> Process ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
1000000 ReceivePort ()
rp
ProcessId -> String -> Process ()
kill ProcessId
agent String
"finished"
testAgentEventHandling :: TestResult Bool -> Process ()
testAgentEventHandling :: TestResult Bool -> Process ()
testAgentEventHandling TestResult Bool
result = do
ProcessId
us <- Process ProcessId
getSelfPid
ProcessId
timer <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
Int -> Process ()
pause (Int
1000000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5)
TestResult Bool -> Bool -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult Bool
result Bool
False
ProcessId -> String -> Process ()
kill ProcessId
us String
"Test Timed Out"
let initState :: [MxEvent]
initState = [] :: [MxEvent]
(SendPort ()
rc, ReceivePort ()
rs) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
agentPid <- MxAgentId -> [MxEvent] -> [MxSink [MxEvent]] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
"lifecycle-listener-agent") [MxEvent]
initState [
((MxEvent -> MxAgent [MxEvent] MxAction) -> MxSink [MxEvent]
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((MxEvent -> MxAgent [MxEvent] MxAction) -> MxSink [MxEvent])
-> (MxEvent -> MxAgent [MxEvent] MxAction) -> MxSink [MxEvent]
forall a b. (a -> b) -> a -> b
$ \MxEvent
ev -> do
[MxEvent]
st <- MxAgent [MxEvent] [MxEvent]
forall s. MxAgent s s
mxGetLocal
let act :: MxAgent [MxEvent] ()
act =
case MxEvent
ev of
(MxSpawned ProcessId
_) -> [MxEvent] -> MxAgent [MxEvent] ()
forall s. s -> MxAgent s ()
mxSetLocal (MxEvent
evMxEvent -> [MxEvent] -> [MxEvent]
forall a. a -> [a] -> [a]
:[MxEvent]
st)
(MxProcessDied ProcessId
_ DiedReason
_) -> [MxEvent] -> MxAgent [MxEvent] ()
forall s. s -> MxAgent s ()
mxSetLocal (MxEvent
evMxEvent -> [MxEvent] -> [MxEvent]
forall a. a -> [a] -> [a]
:[MxEvent]
st)
MxEvent
_ -> () -> MxAgent [MxEvent] ()
forall a. a -> MxAgent [MxEvent] a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MxAgent [MxEvent] ()
act MxAgent [MxEvent] ()
-> MxAgent [MxEvent] () -> MxAgent [MxEvent] ()
forall a b.
MxAgent [MxEvent] a -> MxAgent [MxEvent] b -> MxAgent [MxEvent] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Process () -> MxAgent [MxEvent] ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent [MxEvent] ())
-> Process () -> MxAgent [MxEvent] ()
forall a b. (a -> b) -> a -> b
$ SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
rc ()) MxAgent [MxEvent] ()
-> MxAgent [MxEvent] MxAction -> MxAgent [MxEvent] MxAction
forall a b.
MxAgent [MxEvent] a -> MxAgent [MxEvent] b -> MxAgent [MxEvent] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MxAgent [MxEvent] MxAction
forall s. MxAgent s MxAction
mxReady),
(((MxEvent, SendPort Bool) -> MxAgent [MxEvent] MxAction)
-> MxSink [MxEvent]
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink (((MxEvent, SendPort Bool) -> MxAgent [MxEvent] MxAction)
-> MxSink [MxEvent])
-> ((MxEvent, SendPort Bool) -> MxAgent [MxEvent] MxAction)
-> MxSink [MxEvent]
forall a b. (a -> b) -> a -> b
$ \(MxEvent
ev, SendPort Bool
sp :: SendPort Bool) -> do
[MxEvent]
st <- MxAgent [MxEvent] [MxEvent]
forall s. MxAgent s s
mxGetLocal
let found :: Bool
found =
case MxEvent
ev of
MxSpawned ProcessId
p ->
Maybe MxEvent -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MxEvent -> Bool) -> Maybe MxEvent -> Bool
forall a b. (a -> b) -> a -> b
$ (MxEvent -> Bool) -> [MxEvent] -> Maybe MxEvent
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MxEvent
ev' ->
case MxEvent
ev' of
(MxSpawned ProcessId
p') -> ProcessId
p' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
p
MxEvent
_ -> Bool
False) [MxEvent]
st
MxProcessDied ProcessId
p DiedReason
r ->
Maybe MxEvent -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MxEvent -> Bool) -> Maybe MxEvent -> Bool
forall a b. (a -> b) -> a -> b
$ (MxEvent -> Bool) -> [MxEvent] -> Maybe MxEvent
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MxEvent
ev' ->
case MxEvent
ev' of
(MxProcessDied ProcessId
p' DiedReason
r') -> ProcessId
p' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
p Bool -> Bool -> Bool
&& DiedReason
r DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
r'
MxEvent
_ -> Bool
False) [MxEvent]
st
MxEvent
_ -> Bool
False
Process () -> MxAgent [MxEvent] ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent [MxEvent] ())
-> Process () -> MxAgent [MxEvent] ()
forall a b. (a -> b) -> a -> b
$ SendPort Bool -> Bool -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort Bool
sp Bool
found
MxAgent [MxEvent] MxAction
forall s. MxAgent s MxAction
mxReady)
]
Int -> ReceivePort () -> Process ()
forall {a}.
(Binary a, Typeable a) =>
Int -> ReceivePort a -> Process ()
faff Int
2000000 ReceivePort ()
rs
(SendPort ()
sp, ReceivePort ()
rp) <- Process (SendPort (), ReceivePort ())
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort (), ReceivePort ())
ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ 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
>>= SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ()
sp
ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid ()
Maybe ()
rct <- Int -> ReceivePort () -> Process (Maybe ())
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort ()
rp
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe () -> Bool
forall a. Maybe a -> Bool
isJust Maybe ()
rct) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"No response on channel"
Maybe ()
pmn <- Int -> [Match ()] -> Process (Maybe ())
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
2000000 [ (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\ProcessMonitorNotification{} -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ]
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe () -> Bool
forall a. Maybe a -> Bool
isJust Maybe ()
pmn) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"No monitor notification arrived"
Int -> ReceivePort () -> Process ()
forall {a}.
(Binary a, Typeable a) =>
Int -> ReceivePort a -> Process ()
faff Int
2000000 ReceivePort ()
rs
(SendPort Bool
replyTo, ReceivePort Bool
reply) <- Process (SendPort Bool, ReceivePort Bool)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan :: Process (SendPort Bool, ReceivePort Bool)
(MxEvent, SendPort Bool) -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify (ProcessId -> MxEvent
MxSpawned ProcessId
pid, SendPort Bool
replyTo)
(MxEvent, SendPort Bool) -> Process ()
forall a. Serializable a => a -> Process ()
mxNotify (ProcessId -> DiedReason -> MxEvent
MxProcessDied ProcessId
pid DiedReason
DiedNormal, SendPort Bool
replyTo)
Maybe Bool
seenAlive <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort Bool
reply
Maybe Bool
seenDead <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
10000000 ReceivePort Bool
reply
TestResult Bool -> Bool -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult Bool
result (Bool -> Process ()) -> Bool -> Process ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(&&) Bool
True ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe Bool] -> [Bool]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Bool
seenAlive, Maybe Bool
seenDead]
ProcessId -> String -> Process ()
kill ProcessId
timer String
"test-complete"
ProcessId -> String -> Process ()
kill ProcessId
agentPid String
"test-complete"
where
faff :: Int -> ReceivePort a -> Process ()
faff Int
delay ReceivePort a
port = do
Maybe a
res <- Int -> ReceivePort a -> Process (Maybe a)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort a
port
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
res) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ Int -> Process ()
pause Int
delay
testMxRegEvents :: TestResult () -> Process ()
testMxRegEvents :: TestResult () -> Process ()
testMxRegEvents TestResult ()
result = do
Process () -> Process () -> Process ()
ensure (TestResult () -> () -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult ()
result ()) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
let label :: String
label = String
"testMxRegEvents"
let agentLabel :: String
agentLabel = String
"mxRegEvents-agent"
let delay :: Int
delay = Int
1000000
(SendPort (String, ProcessId)
regChan, ReceivePort (String, ProcessId)
regSink) <- Process
(SendPort (String, ProcessId), ReceivePort (String, ProcessId))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort (String, ProcessId)
unRegChan, ReceivePort (String, ProcessId)
unRegSink) <- Process
(SendPort (String, ProcessId), ReceivePort (String, ProcessId))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
agent <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
agentLabel) () [
(MxEvent -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((MxEvent -> MxAgent () MxAction) -> MxSink ())
-> (MxEvent -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \MxEvent
ev -> do
case MxEvent
ev of
MxRegistered ProcessId
pid String
label'
| String
label' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort (String, ProcessId) -> (String, ProcessId) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (String, ProcessId)
regChan (String
label', ProcessId
pid)
MxUnRegistered ProcessId
pid String
label'
| String
label' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort (String, ProcessId) -> (String, ProcessId) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (String, ProcessId)
unRegChan (String
label', ProcessId
pid)
MxEvent
_ -> () -> MxAgent () ()
forall a. a -> MxAgent () a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
ProcessId
p1 <- Process () -> Process ProcessId
spawnLocal Process ()
forall a. Serializable a => Process a
expect
ProcessId
p2 <- Process () -> Process ProcessId
spawnLocal Process ()
forall a. Serializable a => Process a
expect
String -> ProcessId -> Process ()
register String
label ProcessId
p1
Maybe (String, ProcessId)
reg1 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
regSink
Maybe (String, ProcessId)
reg1 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label, ProcessId
p1))
String -> Process ()
unregister String
label
Maybe (String, ProcessId)
unreg1 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
unRegSink
Maybe (String, ProcessId)
unreg1 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label, ProcessId
p1))
String -> ProcessId -> Process ()
register String
label ProcessId
p2
Maybe (String, ProcessId)
reg2 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
regSink
Maybe (String, ProcessId)
reg2 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label, ProcessId
p2))
String -> ProcessId -> Process ()
reregister String
label ProcessId
p1
Maybe (String, ProcessId)
unreg2 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
unRegSink
Maybe (String, ProcessId)
unreg2 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label, ProcessId
p2))
Maybe (String, ProcessId)
reg3 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
regSink
Maybe (String, ProcessId)
reg3 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label, ProcessId
p1))
(ProcessId -> Process ()) -> [ProcessId] -> Process ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ProcessId -> String -> Process ())
-> String -> ProcessId -> Process ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProcessId -> String -> Process ()
kill (String -> ProcessId -> Process ())
-> String -> ProcessId -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"test-complete") [ProcessId
agent, ProcessId
p1, ProcessId
p2]
testMxRegMon :: LocalNode -> TestResult () -> Process ()
testMxRegMon :: LocalNode -> TestResult () -> Process ()
testMxRegMon LocalNode
remoteNode TestResult ()
result = do
Process () -> Process () -> Process ()
ensure (TestResult () -> () -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult ()
result ()) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ do
let label1 :: String
label1 = String
"aaaaa"
let label2 :: String
label2 = String
"bbbbb"
let isValid :: String -> Bool
isValid String
l = String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label1 Bool -> Bool -> Bool
|| String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label2
let agentLabel :: String
agentLabel = String
"mxRegMon-agent"
let delay :: Int
delay = Int
1000000
(SendPort (String, ProcessId)
regChan, ReceivePort (String, ProcessId)
regSink) <- Process
(SendPort (String, ProcessId), ReceivePort (String, ProcessId))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort (String, ProcessId)
unRegChan, ReceivePort (String, ProcessId)
unRegSink) <- Process
(SendPort (String, ProcessId), ReceivePort (String, ProcessId))
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
agent <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId String
agentLabel) () [
(MxEvent -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((MxEvent -> MxAgent () MxAction) -> MxSink ())
-> (MxEvent -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \MxEvent
ev -> do
case MxEvent
ev of
MxRegistered ProcessId
pid String
label
| String -> Bool
isValid String
label -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort (String, ProcessId) -> (String, ProcessId) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (String, ProcessId)
regChan (String
label, ProcessId
pid)
MxUnRegistered ProcessId
pid String
label
| String -> Bool
isValid String
label -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort (String, ProcessId) -> (String, ProcessId) -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort (String, ProcessId)
unRegChan (String
label, ProcessId
pid)
MxEvent
_ -> () -> MxAgent () ()
forall a. a -> MxAgent () a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
(SendPort ProcessId
sp, ReceivePort ProcessId
rp) <- Process (SendPort ProcessId, ReceivePort ProcessId)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
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
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
remoteNode (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
>>= SendPort ProcessId -> ProcessId -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ProcessId
sp
Process ()
forall a. Serializable a => Process a
expect :: Process ()
ProcessId
p1 <- ReceivePort ProcessId -> Process ProcessId
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort ProcessId
rp
String -> ProcessId -> Process ()
register String
label1 ProcessId
p1
Maybe (String, ProcessId)
reg1 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
regSink
Maybe (String, ProcessId)
reg1 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label1, ProcessId
p1))
String -> ProcessId -> Process ()
register String
label2 ProcessId
p1
Maybe (String, ProcessId)
reg2 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
regSink
Maybe (String, ProcessId)
reg2 Maybe (String, ProcessId)
-> Matcher (Maybe (String, ProcessId)) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe (String, ProcessId) -> Matcher (Maybe (String, ProcessId))
forall a. (Show a, Eq a) => a -> Matcher a
equalTo ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label2, ProcessId
p1))
Maybe ProcessId
n1 <- String -> Process (Maybe ProcessId)
whereis String
label1
Maybe ProcessId
n1 Maybe ProcessId -> Matcher (Maybe ProcessId) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe ProcessId -> Matcher (Maybe ProcessId)
forall a. (Show a, Eq a) => a -> Matcher a
equalTo (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p1)
Maybe ProcessId
n2 <- String -> Process (Maybe ProcessId)
whereis String
label2
Maybe ProcessId
n2 Maybe ProcessId -> Matcher (Maybe ProcessId) -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Maybe ProcessId -> Matcher (Maybe ProcessId)
forall a. (Show a, Eq a) => a -> Matcher a
equalTo (ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p1)
ProcessId -> String -> Process ()
kill ProcessId
p1 String
"goodbye"
Maybe (String, ProcessId)
unreg1 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
unRegSink
Maybe (String, ProcessId)
unreg2 <- Int
-> ReceivePort (String, ProcessId)
-> Process (Maybe (String, ProcessId))
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort (String, ProcessId)
unRegSink
let evts :: [Maybe (String, ProcessId)]
evts = [Maybe (String, ProcessId)
unreg1, Maybe (String, ProcessId)
unreg2]
[Maybe (String, ProcessId)]
evts [Maybe (String, ProcessId)]
-> Maybe (String, ProcessId) -> Process ()
forall a. (Show a, Eq a) => [a] -> a -> Process ()
`shouldContain` ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label1, ProcessId
p1))
[Maybe (String, ProcessId)]
evts [Maybe (String, ProcessId)]
-> Maybe (String, ProcessId) -> Process ()
forall a. (Show a, Eq a) => [a] -> a -> Process ()
`shouldContain` ((String, ProcessId) -> Maybe (String, ProcessId)
forall a. a -> Maybe a
Just (String
label2, ProcessId
p1))
ProcessId -> String -> Process ()
kill ProcessId
agent String
"test-complete"
ensure :: Process () -> Process () -> Process ()
ensure :: Process () -> Process () -> Process ()
ensure = (Process () -> Process () -> Process ())
-> Process () -> Process () -> Process ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Process () -> Process () -> Process ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally
testNSend :: (String -> () -> Process ())
-> Maybe LocalNode
-> Process ()
testNSend :: (String -> () -> Process ()) -> Maybe LocalNode -> Process ()
testNSend String -> () -> Process ()
op Maybe LocalNode
n = do
ProcessId
us <- Process ProcessId
getSelfPid
let delay :: Int
delay = Int
5000000
let label :: String
label = String
"testMxSend" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us)
let isValid :: String -> Bool
isValid = Maybe LocalNode -> String -> String -> Bool
isValidLabel Maybe LocalNode
n String
label
Maybe LocalNode -> String -> SendTest -> Process ()
testMxSend Maybe LocalNode
n String
label (SendTest -> Process ()) -> SendTest -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
p1 ReceivePort MxEvent
sink -> do
String -> ProcessId -> Process ()
register String
label ProcessId
p1
Maybe MxEvent
reg1 <- Int -> ReceivePort MxEvent -> Process (Maybe MxEvent)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort MxEvent
sink
case Maybe MxEvent
reg1 of
Just (MxRegistered ProcessId
pd String
lb)
| ProcessId
pd ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
p1 Bool -> Bool -> Bool
&& String -> Bool
isValid String
lb -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe MxEvent
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"Reg-Failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe MxEvent -> String
forall a. Show a => a -> String
show Maybe MxEvent
reg1
String -> () -> Process ()
op String
label ()
Maybe MxEvent
sent <- Int -> ReceivePort MxEvent -> Process (Maybe MxEvent)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
delay ReceivePort MxEvent
sink
case Maybe MxEvent
sent of
Just (MxSentToName String
lb ProcessId
by Message
_)
| ProcessId
by ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us Bool -> Bool -> Bool
&& String -> Bool
isValid String
lb -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe MxEvent
_ -> String -> Process Bool
forall a b. Serializable a => a -> Process b
die (String -> Process Bool) -> String -> Process Bool
forall a b. (a -> b) -> a -> b
$ String
"Send-Failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe MxEvent -> String
forall a. Show a => a -> String
show Maybe MxEvent
sent
where
isValidLabel :: Maybe LocalNode -> String -> String -> Bool
isValidLabel Maybe LocalNode
nd String
l1 String
l2
| String
l2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
l2 = Bool
True
| Maybe LocalNode -> Bool
forall a. Maybe a -> Bool
isJust Maybe LocalNode
nd = String
l2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
l1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NodeId -> String
forall a. Show a => a -> String
show (LocalNode -> NodeId
localNodeId (LocalNode -> NodeId) -> LocalNode -> NodeId
forall a b. (a -> b) -> a -> b
$ Maybe LocalNode -> LocalNode
forall a. HasCallStack => Maybe a -> a
fromJust Maybe LocalNode
nd)
| Bool
otherwise = Bool
False
testSend :: (ProcessId -> () -> Process ())
-> Maybe LocalNode
-> Process ()
testSend :: (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend ProcessId -> () -> Process ()
op Maybe LocalNode
n = do
ProcessId
us <- Process ProcessId
getSelfPid
let label :: String
label = String
"testMxSend" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
us)
Maybe LocalNode -> String -> SendTest -> Process ()
testMxSend Maybe LocalNode
n String
label (SendTest -> Process ()) -> SendTest -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
p1 ReceivePort MxEvent
sink -> do
ProcessId -> () -> Process ()
op ProcessId
p1 ()
Maybe MxEvent
sent <- Int -> ReceivePort MxEvent -> Process (Maybe MxEvent)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
5000000 ReceivePort MxEvent
sink
case Maybe MxEvent
sent of
Just (MxSent ProcessId
pidTo ProcessId
pidFrom Message
_)
| ProcessId
pidTo ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
p1 Bool -> Bool -> Bool
&& ProcessId
pidFrom ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe MxEvent
_ -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
testChan :: (SendPort () -> () -> Process ())
-> Maybe LocalNode
-> Process ()
testChan :: (SendPort () -> () -> Process ()) -> Maybe LocalNode -> Process ()
testChan SendPort () -> () -> Process ()
op Maybe LocalNode
n = Maybe LocalNode -> String -> SendTest -> Process ()
testMxSend Maybe LocalNode
n String
"" (SendTest -> Process ()) -> SendTest -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
p1 ReceivePort MxEvent
sink -> do
ProcessId
us <- Process ProcessId
getSelfPid
ProcessId -> ProcessId -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p1 ProcessId
us
Maybe MxEvent
cleared <- Int -> ReceivePort MxEvent -> Process (Maybe MxEvent)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
2000000 ReceivePort MxEvent
sink
case Maybe MxEvent
cleared of
Just (MxSent ProcessId
pidTo ProcessId
pidFrom Message
_)
| ProcessId
pidTo ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
p1 Bool -> Bool -> Bool
&& ProcessId
pidFrom ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe MxEvent
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Received uncleared Mx Event"
Maybe (SendPort ())
chan <- Int -> [Match (SendPort ())] -> Process (Maybe (SendPort ()))
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
5000000 [ (SendPort () -> Process (SendPort ())) -> Match (SendPort ())
forall a b. Serializable a => (a -> Process b) -> Match b
match SendPort () -> Process (SendPort ())
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ]
let ch' :: SendPort ()
ch' = SendPort () -> Maybe (SendPort ()) -> SendPort ()
forall a. a -> Maybe a -> a
fromMaybe (String -> SendPort ()
forall a. HasCallStack => String -> a
error String
"No reply chan received") Maybe (SendPort ())
chan
SendPort () -> () -> Process ()
op SendPort ()
ch' ()
Maybe MxEvent
sent <- Int -> ReceivePort MxEvent -> Process (Maybe MxEvent)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
5000000 ReceivePort MxEvent
sink
case Maybe MxEvent
sent of
Just (MxSentToPort ProcessId
sId SendPortId
spId Message
_)
| ProcessId
sId ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us Bool -> Bool -> Bool
&& SendPortId
spId SendPortId -> SendPortId -> Bool
forall a. Eq a => a -> a -> Bool
== SendPort () -> SendPortId
forall a. SendPort a -> SendPortId
sendPortId SendPort ()
ch' -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe MxEvent
_ -> Bool -> Process Bool
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
type SendTest = ProcessId -> ReceivePort MxEvent -> Process Bool
testMxSend :: Maybe LocalNode -> String -> SendTest -> Process ()
testMxSend :: Maybe LocalNode -> String -> SendTest -> Process ()
testMxSend Maybe LocalNode
mNode String
label SendTest
test = do
ProcessId
us <- Process ProcessId
getSelfPid
(SendPort ProcessId
sp, ReceivePort ProcessId
rp) <- Process (SendPort ProcessId, ReceivePort ProcessId)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
(SendPort MxEvent
chan, ReceivePort MxEvent
sink) <- Process (SendPort MxEvent, ReceivePort MxEvent)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId
agent <- MxAgentId -> () -> [MxSink ()] -> Process ProcessId
forall s. MxAgentId -> s -> [MxSink s] -> Process ProcessId
mxAgent (String -> MxAgentId
MxAgentId (String -> MxAgentId) -> String -> MxAgentId
forall a b. (a -> b) -> a -> b
$ ProcessId -> String
forall a. Show a => a -> String
agentLabel ProcessId
us) () [
(MxEvent -> MxAgent () MxAction) -> MxSink ()
forall s m. Serializable m => (m -> MxAgent s MxAction) -> MxSink s
mxSink ((MxEvent -> MxAgent () MxAction) -> MxSink ())
-> (MxEvent -> MxAgent () MxAction) -> MxSink ()
forall a b. (a -> b) -> a -> b
$ \MxEvent
ev -> do
case MxEvent
ev of
m :: MxEvent
m@(MxSentToPort ProcessId
_ SendPortId
cid Message
_)
| SendPortId
cid SendPortId -> SendPortId -> Bool
forall a. Eq a => a -> a -> Bool
/= SendPort MxEvent -> SendPortId
forall a. SendPort a -> SendPortId
sendPortId SendPort MxEvent
chan
Bool -> Bool -> Bool
&& SendPortId
cid SendPortId -> SendPortId -> Bool
forall a. Eq a => a -> a -> Bool
/= SendPort ProcessId -> SendPortId
forall a. SendPort a -> SendPortId
sendPortId SendPort ProcessId
sp -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort MxEvent -> MxEvent -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort MxEvent
chan MxEvent
m
m :: MxEvent
m@(MxSent ProcessId
_ ProcessId
fromPid Message
_)
| ProcessId
fromPid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort MxEvent -> MxEvent -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort MxEvent
chan MxEvent
m
m :: MxEvent
m@(MxSentToName String
_ ProcessId
fromPid Message
_)
| ProcessId
fromPid ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
us -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort MxEvent -> MxEvent -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort MxEvent
chan MxEvent
m
m :: MxEvent
m@(MxRegistered ProcessId
_ String
name)
| String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
label -> Process () -> MxAgent () ()
forall a s. Process a -> MxAgent s a
liftMX (Process () -> MxAgent () ()) -> Process () -> MxAgent () ()
forall a b. (a -> b) -> a -> b
$ SendPort MxEvent -> MxEvent -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort MxEvent
chan MxEvent
m
MxEvent
_ -> () -> MxAgent () ()
forall a. a -> MxAgent () a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MxAgent () MxAction
forall s. MxAgent s MxAction
mxReady
]
case Maybe LocalNode
mNode of
Maybe LocalNode
Nothing -> 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 (SendPort ProcessId -> Process ()
proc SendPort ProcessId
sp)
Just LocalNode
remoteNode -> 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
$ 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
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
remoteNode (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ SendPort ProcessId -> Process ()
proc SendPort ProcessId
sp
Maybe ProcessId
p1 <- Int -> ReceivePort ProcessId -> Process (Maybe ProcessId)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
2000000 ReceivePort ProcessId
rp
Bool -> Process () -> Process ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe ProcessId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ProcessId
p1) (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> Process ()
forall a b. Serializable a => a -> Process b
die String
"Timed out waiting for ProcessId"
Either ProcessExitException Bool
res <- Process Bool -> Process (Either ProcessExitException Bool)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Process Bool -> Process (Either ProcessExitException Bool))
-> Process Bool -> Process (Either ProcessExitException Bool)
forall a b. (a -> b) -> a -> b
$ SendTest
test (Maybe ProcessId -> ProcessId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ProcessId
p1) ReceivePort MxEvent
sink
ProcessId -> String -> Process ()
kill ProcessId
agent String
"bye"
ProcessId -> String -> Process ()
kill (Maybe ProcessId -> ProcessId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ProcessId
p1) String
"bye"
case Either ProcessExitException Bool
res of
Left (ProcessExitException ProcessId
_ Message
m) -> (IO () -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"SomeException-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Message -> String
forall a. Show a => a -> String
show Message
m) Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Message -> Process ()
forall a b. Serializable a => a -> Process b
die Message
m
Right Bool
tr -> Bool
tr Bool -> Matcher Bool -> Process ()
forall a. a -> Matcher a -> Process ()
`shouldBe` Bool -> Matcher Bool
forall a. (Show a, Eq a) => a -> Matcher a
equalTo Bool
True
where
agentLabel :: a -> String
agentLabel a
s = String
"mx-unsafe-check-agent-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s
proc :: SendPort ProcessId -> Process ()
proc SendPort ProcessId
sp' = 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
>>= SendPort ProcessId -> ProcessId -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan SendPort ProcessId
sp' Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ReceivePort ()) -> Process ()
go Maybe (ReceivePort ())
forall a. Maybe a
Nothing
go :: Maybe (ReceivePort ()) -> Process ()
go :: Maybe (ReceivePort ()) -> Process ()
go Maybe (ReceivePort ())
Nothing = Int -> [Match (ReceivePort ())] -> Process (Maybe (ReceivePort ()))
forall b. Int -> [Match b] -> Process (Maybe b)
receiveTimeout Int
5000000 [ (ProcessId -> Process (ReceivePort ())) -> Match (ReceivePort ())
forall a b. Serializable a => (a -> Process b) -> Match b
match ProcessId -> Process (ReceivePort ())
forall {a}.
(Binary a, Typeable a) =>
ProcessId -> Process (ReceivePort a)
replyChannel ] Process (Maybe (ReceivePort ()))
-> (Maybe (ReceivePort ()) -> 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
>>= Maybe (ReceivePort ()) -> Process ()
go
go c :: Maybe (ReceivePort ())
c@(Just ReceivePort ()
c') = [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [ ReceivePort () -> (() -> Process ()) -> Match ()
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort ()
c' () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ] Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ReceivePort ()) -> Process ()
go Maybe (ReceivePort ())
c
replyChannel :: ProcessId -> Process (ReceivePort a)
replyChannel ProcessId
p' = do
(SendPort a
s, ReceivePort a
r) <- Process (SendPort a, ReceivePort a)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan
ProcessId -> SendPort a -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
p' SendPort a
s
ReceivePort a -> Process (ReceivePort a)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ReceivePort a
r
tests :: TestTransport -> IO [Test]
tests :: TestTransport -> IO [Test]
tests TestTransport{Transport
EndPointAddress -> EndPointAddress -> IO ()
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> IO ()
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> IO ()
testTransport :: TestTransport -> Transport
..} = do
LocalNode
node1 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
LocalNode
node2 <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
[Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [
String -> [Test] -> Test
testGroup String
"MxAgents" [
String -> IO () -> Test
testCase String
"EventHandling"
(String
-> LocalNode -> Bool -> (TestResult Bool -> Process ()) -> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected True, but events where not as expected"
LocalNode
node1 Bool
True TestResult Bool -> Process ()
testAgentEventHandling)
, String -> IO () -> Test
testCase String
"InterAgentBroadcast"
(String
-> LocalNode
-> Maybe ()
-> (TestResult (Maybe ()) -> Process ())
-> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected (), but no broadcast was received"
LocalNode
node1 (() -> Maybe ()
forall a. a -> Maybe a
Just ()) TestResult (Maybe ()) -> Process ()
testAgentBroadcast)
, String -> IO () -> Test
testCase String
"AgentMailboxHandling"
(String
-> LocalNode
-> Maybe ()
-> (TestResult (Maybe ()) -> Process ())
-> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected (Just ()), but no regular (mailbox) input was handled"
LocalNode
node1 (() -> Maybe ()
forall a. a -> Maybe a
Just ()) TestResult (Maybe ()) -> Process ()
testAgentMailboxHandling)
, String -> IO () -> Test
testCase String
"AgentDualInputHandling"
(String
-> LocalNode
-> Maybe Int
-> (TestResult (Maybe Int) -> Process ())
-> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected sum = 15, but the result was Nothing"
LocalNode
node1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
15 :: Maybe Int) TestResult (Maybe Int) -> Process ()
testAgentDualInput)
, String -> IO () -> Test
testCase String
"AgentInputPrioritisation"
(String
-> LocalNode
-> [String]
-> (TestResult [String] -> Process ())
-> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected [first, second, third, fourth, fifth], but result diverged"
LocalNode
node1 ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String
"first", String
"second",
String
"third", String
"fourth",
String
"fifth"]) TestResult [String] -> Process ()
testAgentPrioritisation)
]
, String -> [Test] -> Test
testGroup String
"MxEvents" [
String -> IO () -> Test
testCase String
"NameRegistrationEvents"
(String -> LocalNode -> () -> (TestResult () -> Process ()) -> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected registration events to map to the correct ProcessId"
LocalNode
node1 () TestResult () -> Process ()
testMxRegEvents)
, String -> IO () -> Test
testCase String
"PostDeathNameUnRegistrationEvents"
(String -> LocalNode -> () -> (TestResult () -> Process ()) -> IO ()
forall a.
Eq a =>
String -> LocalNode -> a -> (TestResult a -> Process ()) -> IO ()
delayedAssertion
String
"expected process deaths to result in unregistration events"
LocalNode
node1 () (LocalNode -> TestResult () -> Process ()
testMxRegMon LocalNode
node2))
, String -> [Test] -> Test
testGroup String
"SendEvents" ([Test] -> Test) -> [Test] -> Test
forall a b. (a -> b) -> a -> b
$ LocalNode -> LocalNode -> [Test]
buildTestCases LocalNode
node1 LocalNode
node2
]
]
where
buildTestCases :: LocalNode -> LocalNode -> [Test]
buildTestCases LocalNode
n1 LocalNode
n2 = let nid :: NodeId
nid = LocalNode -> NodeId
localNodeId LocalNode
n2 in LocalNode
-> LocalNode
-> [(String, [(String, Maybe LocalNode -> Process ())])]
-> [Test]
build LocalNode
n1 LocalNode
n2 [
(String
"NSend", [
(String
"nsend", (String -> () -> Process ()) -> Maybe LocalNode -> Process ()
testNSend String -> () -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend)
, (String
"Unsafe.nsend", (String -> () -> Process ()) -> Maybe LocalNode -> Process ()
testNSend String -> () -> Process ()
forall a. Serializable a => String -> a -> Process ()
Unsafe.nsend)
, (String
"nsendRemote", (String -> () -> Process ()) -> Maybe LocalNode -> Process ()
testNSend (NodeId -> String -> () -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
nid))
, (String
"Unsafe.nsendRemote", (String -> () -> Process ()) -> Maybe LocalNode -> Process ()
testNSend (NodeId -> String -> () -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
Unsafe.nsendRemote NodeId
nid))
])
, (String
"Send", [
(String
"send", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send)
, (String
"Unsafe.send", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
Unsafe.send)
, (String
"usend", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
usend)
, (String
"Unsafe.usend", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend ProcessId -> () -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
Unsafe.usend)
, (String
"sendChan", (SendPort () -> () -> Process ()) -> Maybe LocalNode -> Process ()
testChan SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
sendChan)
, (String
"Unsafe.sendChan", (SendPort () -> () -> Process ()) -> Maybe LocalNode -> Process ()
testChan SendPort () -> () -> Process ()
forall a. Serializable a => SendPort a -> a -> Process ()
Unsafe.sendChan)
])
, (String
"Forward", [
(String
"forward", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend (\ProcessId
p ()
m -> Message -> ProcessId -> Process ()
forward (() -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ()
m) ProcessId
p))
, (String
"uforward", (ProcessId -> () -> Process ()) -> Maybe LocalNode -> Process ()
testSend (\ProcessId
p ()
m -> Message -> ProcessId -> Process ()
uforward (() -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ()
m) ProcessId
p))
])
]
build :: LocalNode
-> LocalNode
-> [(String, [(String, (Maybe LocalNode -> Process ()))])]
-> [Test]
build :: LocalNode
-> LocalNode
-> [(String, [(String, Maybe LocalNode -> Process ())])]
-> [Test]
build LocalNode
n LocalNode
ln [(String, [(String, Maybe LocalNode -> Process ())])]
specs =
[ String -> [Test] -> Test
testGroup (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String
groupName, String
caseSuffix]) [
String -> IO () -> Test
testCase (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String
caseName, String
caseSuffix])
(LocalNode -> Process () -> IO ()
runProcess LocalNode
n (Maybe LocalNode -> Process ()
caseImpl Maybe LocalNode
caseNode))
| (String
caseName, Maybe LocalNode -> Process ()
caseImpl) <- [(String, Maybe LocalNode -> Process ())]
groupCases
]
| (String
groupName, [(String, Maybe LocalNode -> Process ())]
groupCases) <- [(String, [(String, Maybe LocalNode -> Process ())])]
specs
, (String
caseSuffix, Maybe LocalNode
caseNode) <- [(String
"RemotePid", LocalNode -> Maybe LocalNode
forall a. a -> Maybe a
Just LocalNode
ln), (String
"LocalPid", Maybe LocalNode
forall a. Maybe a
Nothing)]
]