{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Control.Distributed.Process.Tests.Stats (tests) where
import Control.Distributed.Process.Tests.Internal.Utils
import Network.Transport.Test (TestTransport(..))
import Control.Concurrent.MVar
( MVar
, newEmptyMVar
, putMVar
, takeMVar
)
import Control.Distributed.Process
import Control.Distributed.Process.Node
import Data.Binary ()
import Data.Typeable ()
#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
import Test.Framework
( Test
, testGroup
)
import Test.HUnit (Assertion)
import Test.Framework.Providers.HUnit (testCase)
testLocalDeadProcessInfo :: TestResult (Maybe ProcessInfo) -> Process ()
testLocalDeadProcessInfo :: TestResult (Maybe ProcessInfo) -> Process ()
testLocalDeadProcessInfo TestResult (Maybe ProcessInfo)
result = do
ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do (String
_ :: String) <- Process String
forall a. Serializable a => Process a
expect; () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MonitorRef
mref <- ProcessId -> Process MonitorRef
monitor ProcessId
pid
ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid String
"finish"
ProcessMonitorNotification
_ <- [Match ProcessMonitorNotification]
-> Process ProcessMonitorNotification
forall b. [Match b] -> Process b
receiveWait [
(ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification
-> Process ProcessMonitorNotification)
-> Match ProcessMonitorNotification
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf (\(ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
r) ->
MonitorRef
ref' MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
mref Bool -> Bool -> Bool
&& ProcessId
pid' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid Bool -> Bool -> Bool
&& DiedReason
r DiedReason -> DiedReason -> Bool
forall a. Eq a => a -> a -> Bool
== DiedReason
DiedNormal)
(\ProcessMonitorNotification
p -> ProcessMonitorNotification -> Process ProcessMonitorNotification
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessMonitorNotification
p)
]
ProcessId -> Process (Maybe ProcessInfo)
getProcessInfo ProcessId
pid Process (Maybe ProcessInfo)
-> (Maybe ProcessInfo -> 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
>>= TestResult (Maybe ProcessInfo) -> Maybe ProcessInfo -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult (Maybe ProcessInfo)
result
testLocalLiveProcessInfo :: TestResult Bool -> Process ()
testLocalLiveProcessInfo :: TestResult Bool -> Process ()
testLocalLiveProcessInfo TestResult Bool
result = do
ProcessId
self <- Process ProcessId
getSelfPid
NodeId
node <- Process NodeId
getSelfNode
String -> ProcessId -> Process ()
register String
"foobar" ProcessId
self
MVar MonitorRef
mon <- IO (MVar MonitorRef) -> Process (MVar MonitorRef)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar MonitorRef) -> Process (MVar MonitorRef))
-> IO (MVar MonitorRef) -> Process (MVar MonitorRef)
forall a b. (a -> b) -> a -> b
$ IO (MVar MonitorRef)
forall a. IO (MVar a)
newEmptyMVar
ProcessId
pid <- Process () -> Process ProcessId
spawnLocal (Process () -> Process ProcessId)
-> Process () -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ do
ProcessId -> Process ()
link ProcessId
self
MonitorRef
mRef <- ProcessId -> Process MonitorRef
monitor ProcessId
self
MVar MonitorRef -> MonitorRef -> Process ()
forall a. TestResult a -> a -> Process ()
stash MVar MonitorRef
mon MonitorRef
mRef
String
res <- Process String
forall a. Serializable a => Process a
expect
case String
res of
String
"die" -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"unexpected message received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
res
MonitorRef
monRef <- IO MonitorRef -> Process MonitorRef
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MonitorRef -> Process MonitorRef)
-> IO MonitorRef -> Process MonitorRef
forall a b. (a -> b) -> a -> b
$ MVar MonitorRef -> IO MonitorRef
forall a. MVar a -> IO a
takeMVar MVar MonitorRef
mon
Maybe ProcessInfo
mpInfo <- ProcessId -> Process (Maybe ProcessInfo)
getProcessInfo ProcessId
self
case Maybe ProcessInfo
mpInfo of
Maybe ProcessInfo
Nothing -> TestResult Bool -> Bool -> Process ()
forall a. TestResult a -> a -> Process ()
stash TestResult Bool
result Bool
False
Just ProcessInfo
p -> ProcessInfo -> ProcessId -> MonitorRef -> NodeId -> Process ()
verifyPInfo ProcessInfo
p ProcessId
pid MonitorRef
monRef NodeId
node
where verifyPInfo :: ProcessInfo
-> ProcessId
-> MonitorRef
-> NodeId
-> Process ()
verifyPInfo :: ProcessInfo -> ProcessId -> MonitorRef -> NodeId -> Process ()
verifyPInfo ProcessInfo
pInfo ProcessId
pid MonitorRef
mref NodeId
node =
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
$ ProcessInfo -> NodeId
infoNode ProcessInfo
pInfo NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
node Bool -> Bool -> Bool
&&
ProcessInfo -> [ProcessId]
infoLinks ProcessInfo
pInfo [ProcessId] -> [ProcessId] -> Bool
forall a. Eq a => a -> a -> Bool
== [ProcessId
pid] Bool -> Bool -> Bool
&&
ProcessInfo -> [(ProcessId, MonitorRef)]
infoMonitors ProcessInfo
pInfo [(ProcessId, MonitorRef)] -> [(ProcessId, MonitorRef)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(ProcessId
pid, MonitorRef
mref)] Bool -> Bool -> Bool
&&
ProcessInfo -> [String]
infoRegisteredNames ProcessInfo
pInfo [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"foobar"]
testRemoteLiveProcessInfo :: TestTransport -> LocalNode -> Assertion
testRemoteLiveProcessInfo :: TestTransport -> LocalNode -> Assertion
testRemoteLiveProcessInfo TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
..} LocalNode
node1 = do
MVar ProcessId
serverAddr <- IO (MVar ProcessId) -> IO (MVar ProcessId)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ProcessId) -> IO (MVar ProcessId))
-> IO (MVar ProcessId) -> IO (MVar ProcessId)
forall a b. (a -> b) -> a -> b
$ IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar ProcessId)
Assertion -> Assertion
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$ MVar ProcessId -> Assertion
launchRemote MVar ProcessId
serverAddr
ProcessId
serverPid <- 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
serverAddr
LocalNode -> (TestResult Bool -> Process ()) -> Assertion
withActiveRemote LocalNode
node1 ((TestResult Bool -> Process ()) -> Assertion)
-> (TestResult Bool -> Process ()) -> Assertion
forall a b. (a -> b) -> a -> b
$ \TestResult Bool
result -> do
ProcessId
self <- Process ProcessId
getSelfPid
ProcessId -> Process ()
link ProcessId
serverPid
ProcessId -> (ProcessId, String) -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
serverPid (ProcessId
self, String
"ping")
String
pong <- Process String
forall a. Serializable a => Process a
expect
Maybe ProcessInfo
pInfo <- ProcessId -> Process (Maybe ProcessInfo)
getProcessInfo ProcessId
serverPid
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
$ String
pong String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"pong" Bool -> Bool -> Bool
&& Maybe ProcessInfo
pInfo Maybe ProcessInfo -> Maybe ProcessInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ProcessInfo
forall a. Maybe a
Nothing
where
launchRemote :: MVar ProcessId -> IO ()
launchRemote :: MVar ProcessId -> Assertion
launchRemote MVar ProcessId
locMV = do
LocalNode
node2 <- IO LocalNode -> IO LocalNode
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LocalNode -> IO LocalNode) -> IO LocalNode -> IO LocalNode
forall a b. (a -> b) -> a -> b
$ Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable
ProcessId
_ <- 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
$ LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (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
locMV ProcessId
self
()
_ <- [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
((ProcessId, String) -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match (\(ProcessId
pid, String
"ping") -> ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
pid String
"pong")
]
String
res <- Process String
forall a. Serializable a => Process a
expect
case String
res of
String
"stop" -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String
_ -> String -> Process ()
forall a b. Serializable a => a -> Process b
die (String -> Process ()) -> String -> Process ()
forall a b. (a -> b) -> a -> b
$ String
"unexpected message received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
res
() -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
withActiveRemote :: LocalNode
-> ((TestResult Bool -> Process ()) -> Assertion)
withActiveRemote :: LocalNode -> (TestResult Bool -> Process ()) -> Assertion
withActiveRemote LocalNode
n = do
Assertion
a <- String
-> LocalNode
-> Bool
-> (TestResult Bool -> Process ())
-> Assertion
forall a.
Eq a =>
String
-> LocalNode -> a -> (TestResult a -> Process ()) -> Assertion
delayedAssertion String
"getProcessInfo remotePid failed" LocalNode
n Bool
True
Assertion -> (TestResult Bool -> Process ()) -> Assertion
forall a. a -> (TestResult Bool -> Process ()) -> a
forall (m :: * -> *) a. Monad m => a -> m a
return Assertion
a
tests :: TestTransport -> IO [Test]
tests :: TestTransport -> IO [Test]
tests testtrans :: TestTransport
testtrans@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
[Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [
String -> [Test] -> Test
testGroup String
"Process Info" [
String -> Assertion -> Test
testCase String
"testLocalDeadProcessInfo"
(String
-> LocalNode
-> Maybe ProcessInfo
-> (TestResult (Maybe ProcessInfo) -> Process ())
-> Assertion
forall a.
Eq a =>
String
-> LocalNode -> a -> (TestResult a -> Process ()) -> Assertion
delayedAssertion
String
"expected dead process-info to be ProcessInfoNone"
LocalNode
node1 (Maybe ProcessInfo
forall a. Maybe a
Nothing) TestResult (Maybe ProcessInfo) -> Process ()
testLocalDeadProcessInfo)
, String -> Assertion -> Test
testCase String
"testLocalLiveProcessInfo"
(String
-> LocalNode
-> Bool
-> (TestResult Bool -> Process ())
-> Assertion
forall a.
Eq a =>
String
-> LocalNode -> a -> (TestResult a -> Process ()) -> Assertion
delayedAssertion
String
"expected process-info to be correctly populated"
LocalNode
node1 Bool
True TestResult Bool -> Process ()
testLocalLiveProcessInfo)
, String -> Assertion -> Test
testCase String
"testRemoveLiveProcessInfo"
(TestTransport -> LocalNode -> Assertion
testRemoteLiveProcessInfo TestTransport
testtrans LocalNode
node1)
] ]