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.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.Monad.Catch as Ex (catch, finally, mask, onException, try)
import Control.Exception (SomeException, throwIO, ErrorCall(..))
import Control.Applicative ((<$>), (<*>), pure, (<|>))
import qualified Network.Transport as NT (closeEndPoint, EndPointAddress)
import Control.Distributed.Process
import Control.Distributed.Process.Internal.Types
  ( NodeId(nodeAddress)
  , LocalNode(localEndPoint)
  , ProcessExitException(..)
  , nullProcessId
  , createUnencodedMessage
  )
import Control.Distributed.Process.Node
import Control.Distributed.Process.Serializable (Serializable)

import Test.HUnit (Assertion, assertFailure)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Control.Rematch hiding (match)
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)

--------------------------------------------------------------------------------
-- Supporting definitions                                                     --
--------------------------------------------------------------------------------

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

-- | Like fork, but throw exceptions in the child thread to the parent
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
Ex.catch Assertion
p (\SomeException
e -> ThreadId -> SomeException -> Assertion
forall e. Exception e => ThreadId -> e -> Assertion
throwTo ThreadId
tid (SomeException
e :: SomeException))

-- | The ping server from the paper
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

-- | Quick and dirty synchronous version of whereisRemoteAsync
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
  WhereIsReply String
_ Maybe ProcessId
mPid <- Process WhereIsReply
forall a. Serializable a => Process a
expect
  Maybe ProcessId -> Process (Maybe ProcessId)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessId
mPid

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

-- The math server from the paper
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

-- | Monitor or link to a remote node
monitorOrLink :: Bool            -- ^ 'True' for monitor, 'False' for link
              -> ProcessId       -- ^ Process to monitor/link to
              -> Maybe (MVar ()) -- ^ MVar to signal on once the monitor has been set up
              -> 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
  -- Monitor is asynchronous, which usually does not matter but if we want a
  --  *specific* signal then it does. Therefore we wait until the MonitorRef is
  -- listed in the ProcessInfo and hope that this means the monitor has been set
  -- up.
  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       -- Process to monitor/link to
                   -> Bool            -- 'True' for monitor, 'False' for link
                   -> Bool            -- Should we unmonitor?
                   -> DiedReason      -- Expected cause of death
                   -> Maybe (MVar ()) -- Signal for 'monitor set up'
                   -> MVar ()         -- Signal for successful termination
                   -> 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
Ex.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
                  ProcessMonitorNotification MonitorRef
ref' ProcessId
pid DiedReason
reason' <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
                  Bool
True <- 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 -> 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'
                  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 ()
          )
        (\(ProcessLinkException ProcessId
pid DiedReason
reason') -> do
            Bool
True <- 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
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 ()
        )

--------------------------------------------------------------------------------
-- The tests proper                                                           --
--------------------------------------------------------------------------------

-- | Basic ping test
testPing :: TestTransport -> Assertion
testPing :: TestTransport -> Assertion
testPing TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> 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

  -- 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
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

  -- Client
  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)
        Ping ProcessId
_ <- Process Ping
forall a. Serializable a => Process a
expect
        () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Monitor a process on an unreachable node
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable :: TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

-- | Monitor a process which terminates normally
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorNormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

-- | Monitor a process which terminates abnormally
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination :: TestTransport -> Bool -> Bool -> Assertion
testMonitorAbnormalTermination TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

-- | Monitor a local process that is already dead
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorLocalDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
      -- wait for the process to die
      ProcessMonitorNotification MonitorRef
_ ProcessId
_ DiedReason
_ <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
      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

-- | Monitor a remote process that is already dead
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess :: TestTransport -> Bool -> Bool -> Assertion
testMonitorRemoteDeadProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

-- | Monitor a process that becomes disconnected
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect :: TestTransport -> Bool -> Bool -> Assertion
testMonitorDisconnect TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

-- | Test the math server (i.e., receiveWait)
testMath :: TestTransport -> Assertion
testMath :: TestTransport -> Assertion
testMath TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

  -- 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
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

  -- Client
  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
3 <- 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
4 <- 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
DivByZero <- 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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Send first message (i.e. connect) to an already terminated process
-- (without monitoring); then send another message to a second process on
-- the same remote node (we're checking that the remote node did not die)
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated :: TestTransport -> Assertion
testSendToTerminated TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
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
    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)
      Ping ProcessId
pid' <- Process Ping
forall a. Serializable a => Process a
expect
      Bool
True <- 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
pid' ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
server2
      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

-- | Test (non-zero) timeout
testTimeout :: TestTransport -> Assertion
testTimeout :: TestTransport -> Assertion
testTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

  LocalNode -> Process () -> Assertion
runProcess LocalNode
localNode (Process () -> Assertion) -> Process () -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    Maybe ()
Nothing <- 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 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
$ MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

-- | Test zero timeout
testTimeout0 :: TestTransport -> Assertion
testTimeout0 :: TestTransport -> Assertion
testTimeout0 TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
  MVar ()
messagesSent <- 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
$ 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
readMVar MVar ()
messagesSent Assertion -> Assertion -> Assertion
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Assertion
threadDelay Int
1000000
      -- Variation on the venerable ping server which uses a zero timeout
      -- Since we wait for all messages to be sent before doing this receive,
      -- we should nevertheless find the right message immediately
      Just ProcessId
partner <- 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)]
      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
      -- Send a bunch of messages. A large number of messages that the server
      -- is not interested in, and then a single message that it wants
      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)
      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 ()
messagesSent ()
      Ping ProcessId
_ <- Process Ping
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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Test typed channels
testTypedChannels :: TestTransport -> Assertion
testTypedChannels :: TestTransport -> Assertion
testTypedChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
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
    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
False <- 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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Test merging receive ports
testMergeChannels :: TestTransport -> Assertion
testMergeChannels :: TestTransport -> Assertion
testMergeChannels TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    -- Single layer of merging
    testFlat :: LocalNode -> Bool -> String -> IO ()
    testFlat :: LocalNode -> Bool -> String -> Assertion
testFlat LocalNode
localNode Bool
biased String
expected = do
      MVar ()
done <- IO (MVar ())
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
        Bool
True <- 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
xs 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 ()
      MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

    -- Two layers of merging
    testNested :: LocalNode -> Bool -> Bool -> String -> IO ()
    testNested :: LocalNode -> Bool -> Bool -> String -> Assertion
testNested LocalNode
localNode Bool
biasedInner Bool
biasedOuter String
expected = do
      MVar ()
done <- IO (MVar ())
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
        Bool
True <- 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
xs 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 ()
      MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

    -- Test that if no messages are (immediately) available, the scheduler makes no difference
    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 ()
done <- IO (MVar ())
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
sa, SendPort Char
sb, SendPort Char
sc] <- 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
        ((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
>> Assertion -> Process ()
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Assertion
threadDelay 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)
          [ -- a, b, c
            (SendPort Char
sa, Char
'a')
          , (SendPort Char
sb, Char
'b')
          , (SendPort Char
sc, Char
'c')
            -- a, c, b
          , (SendPort Char
sa, Char
'a')
          , (SendPort Char
sc, Char
'c')
          , (SendPort Char
sb, Char
'b')
            -- b, a, c
          , (SendPort Char
sb, Char
'b')
          , (SendPort Char
sa, Char
'a')
          , (SendPort Char
sc, Char
'c')
            -- b, c, a
          , (SendPort Char
sb, Char
'b')
          , (SendPort Char
sc, Char
'c')
          , (SendPort Char
sa, Char
'a')
            -- c, a, b
          , (SendPort Char
sc, Char
'c')
          , (SendPort Char
sa, Char
'a')
          , (SendPort Char
sb, Char
'b')
            -- c, b, a
          , (SendPort Char
sc, Char
'c')
          , (SendPort Char
sb, Char
'b')
          , (SendPort Char
sa, Char
'a')
          ]

      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
        Bool
True <- 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
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"abcacbbacbcacabcba"
        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

    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 -- Make sure messages have been sent
      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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
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
100000
    Process ()
forall a. Process a
terminate

  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
    ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' (DiedException String
ex) <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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' Bool -> Bool -> Bool
&& String
ex String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessTerminationException -> String
forall a. Show a => a -> String
show ProcessTerminationException
ProcessTerminationException
    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

testMonitorNode :: TestTransport -> Assertion
testMonitorNode :: TestTransport -> Assertion
testMonitorNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
done <- IO (MVar ())
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)
    NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
DiedDisconnect <- Process NodeMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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
    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

testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode :: TestTransport -> Assertion
testMonitorLiveNode TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
done <- IO (MVar ())
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 ()
    NodeMonitorNotification MonitorRef
ref' NodeId
nid DiedReason
_ <- Process NodeMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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
    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 ()
ready
  LocalNode -> Assertion
closeLocalNode LocalNode
node1
  MVar () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
readyr ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel :: TestTransport -> Assertion
testMonitorChannel TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
gotNotification <- 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
      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
      PortMonitorNotification MonitorRef
ref' SendPortId
port' DiedReason
reason <- Process PortMonitorNotification
forall a. Serializable a => Process a
expect
      -- reason might be DiedUnknownId if the receive port is GCed before the
      -- monitor is established (TODO: not sure that this is reasonable)
      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)
      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 ()
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

    MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
gotNotification

testRegistry :: TestTransport -> Assertion
testRegistry :: TestTransport -> Assertion
testRegistry TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    Just ProcessId
pid <- String -> Process (Maybe ProcessId)
whereis String
"ping"
    Bool
True <- 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
    ProcessId
us <- Process ProcessId
getSelfPid
    String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    Ping ProcessId
pid' <- Process Ping
forall a. Serializable a => Process a
expect
    Bool
True <- 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'
    Left (ProcessRegistrationException String
"dead" Maybe ProcessId
Nothing)  <- Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ex.try (Process () -> Process (Either ProcessRegistrationException ()))
-> Process () -> Process (Either ProcessRegistrationException ())
forall a b. (a -> b) -> a -> b
$ String -> ProcessId -> Process ()
register String
"dead" ProcessId
deadProcess
    Left (ProcessRegistrationException String
"ping" (Just ProcessId
x)) <- Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ex.try (Process () -> Process (Either ProcessRegistrationException ()))
-> Process () -> Process (Either ProcessRegistrationException ())
forall a b. (a -> b) -> a -> b
$ String -> ProcessId -> Process ()
register String
"ping" ProcessId
deadProcess
    Bool
True <- 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
x ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pingServer
    Left (ProcessRegistrationException String
"dead" Maybe ProcessId
Nothing) <- Process () -> Process (Either ProcessRegistrationException ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ex.try (Process () -> Process (Either ProcessRegistrationException ()))
-> Process () -> Process (Either ProcessRegistrationException ())
forall a b. (a -> b) -> a -> b
$ String -> Process ()
unregister String
"dead"
    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

testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    Just ProcessId
pid <- String -> Process (Maybe ProcessId)
whereis String
"ping"
    Bool
True <- 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
    ProcessId
us <- Process ProcessId
getSelfPid
    String -> Pong -> Process ()
forall a. Serializable a => String -> a -> Process ()
nsend String
"ping" (ProcessId -> Pong
Pong ProcessId
us)
    Ping ProcessId
pid' <- Process Ping
forall a. Serializable a => Process a
expect
    Bool
True <- 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'
    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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
  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 ()) ]

    Just ProcessId
pid <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"ping"
    Bool
True <- 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
    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)
    Ping ProcessId
pid' <- Process Ping
forall a. Serializable a => Process a
expect
    Bool
True <- 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'

    -- test that if process was not registered Nothing is returned
    -- in owner field.
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"dead" ProcessId
deadProcess
    [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
False Maybe ProcessId
Nothing) -> String
"dead" 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
"ping" ProcessId
deadProcess
    [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
False (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 ()) ]
    NodeId -> String -> Process ()
unregisterRemoteAsync NodeId
nid1 String
"dead"
    [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
False Maybe ProcessId
Nothing) ->
                    String
"dead" 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 ()) ]
    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

testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
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 ()) ]
    Just ProcessId
pid <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"ping"
    Bool
True <- 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
    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)
    Ping ProcessId
pid' <- Process Ping
forall a. Serializable a => Process a
expect
    Bool
True <- 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'
    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

testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

  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 -> do
      (Int
1234 :: Int) <- ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rport
      ProcessId -> () -> 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 ()
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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
done ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness :: TestTransport -> Assertion
testSpawnAsyncStrictness TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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)
Ex.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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    Bool
True <- 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
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"
    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 ()
sendTestOk ()

  LocalNode -> Process () -> IO ProcessId
forkProcess LocalNode
node2 (Process () -> IO ProcessId) -> Process () -> IO ProcessId
forall a b. (a -> b) -> a -> b
$ do
    {-
     - Make sure there is no implicit reconnect on normal message sending
     -}

    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)

    -- Simulate network failure
    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


    -- Should not arrive
    ProcessId -> String -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send ProcessId
them String
"message 2"

    -- Should arrive
    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

    {-
     - Test that there *is* implicit reconnect on node controller messages
     -}

    ProcessId
us <- Process ProcessId
getSelfPid
    NodeId -> String -> ProcessId -> Process ()
registerRemoteAsync NodeId
nid1 String
"a" ProcessId
us -- registerRemote is asynchronous
    [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 ()) ]

    Just ProcessId
_  <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"


    -- Simulate network failure
    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

    -- This will happen due to implicit reconnect
    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 ()) ]

    -- Should happen
    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 ()) ]

    -- Check
    Maybe ProcessId
Nothing  <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"a"  -- this will fail because the name is removed when the node is disconnected
    Just ProcessId
_  <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote NodeId
nid1 String
"b"  -- this will suceed because the value is set after thereconnect
    Just ProcessId
_  <- NodeId -> String -> Process (Maybe ProcessId)
whereisRemote 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

-- | Tests that unreliable messages arrive sorted even when there are connection
-- failures.
testUSend :: (ProcessId -> Int -> Process ())
          -> TestTransport -> Int -> Assertion
testUSend :: (ProcessId -> Int -> Process ())
-> TestTransport -> Int -> Assertion
testUSend ProcessId -> Int -> Process ()
usendPrim TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()
usendTestOk <- 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
$ (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
Ex.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 -- Collects messages from 'them' until the sender dies.
        -- Disconnection notifications are ignored.
        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 -- Checks that the input list is sorted.
        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
    -- The list can't be null since there are no failures after sending
    -- the last message.
    Bool
True <- 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
$ [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)
    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 ()
usendTestOk ()

  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
    [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)

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
usendTestOk

-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
-- in between
testMatchAny :: TestTransport -> Assertion
testMatchAny :: TestTransport -> Assertion
testMatchAny TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  -- Math 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
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

  -- Client
  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
3 <- 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
4 <- 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
DivByZero <- 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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
-- in between, however we block 'Divide' requests ....
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle :: TestTransport -> Assertion
testMatchAnyHandle TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
proxyAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  -- Math 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
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

  -- Client
  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
3 <- 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
Nothing <- (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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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

  -- Math 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 <- 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
            -- the condition has type `Add -> Bool`
            (\(Add ProcessId
_ Double
_ Double
_) -> Bool
True)
            -- the match `AbstractMessage -> Process ()` will succeed!
            (\Message
m -> do
              -- `String -> Process ()` does *not* match the input types however
              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")
          ]
        -- we *must* have removed the message from our mailbox though!!!
        Maybe ()
Nothing <- 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
$ 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

  -- Client
  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)
      -- we only care about the client having sent a message, so we're done
      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

-- | Test 'matchAnyIf'. We provide an /echo/ server, but it ignores requests
-- unless the text body @/= "bar"@ - this case should time out rather than
-- removing the message from the process mailbox.
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf :: TestTransport -> Assertion
testMatchAnyIf TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

  -- echo 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
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

  -- Client
  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
"baz")
      String
"baz" <- 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 Double
Nothing <- (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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone
  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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ProcessId
echoAddr <- IO (MVar ProcessId)
forall a. IO (MVar a)
newEmptyMVar
  MVar ()
clientDone <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

    -- echo 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
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

  -- Client
  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 () -> () -> Assertion
forall a. MVar a -> a -> Assertion
putMVar MVar ()
clientDone ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
clientDone

-- Test 'receiveChanTimeout'
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout :: TestTransport -> Assertion
testReceiveChanTimeout TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  MVar ()
done <- 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
      -- Create a typed channel
      (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

      -- Wait for a message with a delay. No message arrives, we should get Nothing after 1 second
      Maybe Bool
Nothing <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
1000000 ReceivePort Bool
rp

      -- Wait for a message with a delay again. Now a message arrives after 0.5 seconds
      Just Bool
True <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
1000000 ReceivePort Bool
rp

      -- Wait for a message with zero timeout: non-blocking check. No message is available, we get Nothing
      Maybe Bool
Nothing <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
rp

      -- Again, but now there is a message available
      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
      Just Bool
False <- Int -> ReceivePort Bool -> Process (Maybe Bool)
forall a.
Serializable a =>
Int -> ReceivePort a -> Process (Maybe a)
receiveChanTimeout Int
0 ReceivePort Bool
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 () -> () -> 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
$ Int -> Assertion
threadDelay Int
1500000
      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
$ Int -> Assertion
threadDelay Int
500000
      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

-- | Test Functor, Applicative, Alternative and Monad instances for ReceiveChan
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures :: TestTransport -> Assertion
testReceiveChanFeatures TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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)

      -- Test Functor instance

      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]

      Bool
True <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1
      Bool
False <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp1

      -- Test Applicative instance

      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

      Int
7 <- ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp2

      -- Test Alternative instance

      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

      Bool
False <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3
      Bool
True <- ReceivePort Bool -> Process Bool
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Bool
rp3

      -- Test Monad instance

      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

      Int
5 <- ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4
      Int
7 <- ReceivePort Int -> Process Int
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort Int
rp4

      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

testKillLocal :: TestTransport -> Assertion
testKillLocal :: TestTransport -> Assertion
testKillLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
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 MonitorRef
ref' ProcessId
pid' (DiedException String
ex) <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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' 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"
    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

testKillRemote :: TestTransport -> Assertion
testKillRemote :: TestTransport -> Assertion
testKillRemote TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
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 MonitorRef
ref' ProcessId
pid' (DiedException String
reason) <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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' Bool -> Bool -> Bool
&& 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"
    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

testCatchesExit :: TestTransport -> Assertion
testCatchesExit :: TestTransport -> Assertion
testCatchesExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ]
    Maybe Any
Nothing <- 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 -> Process Any) -> String -> Process Any
forall a b. (a -> b) -> a -> b
$ String
"whoops")
    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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
Ex.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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
        -- TODO: should verify that 'from' has the right value
        Bool
True <- 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, 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 ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testPrettyExit :: TestTransport -> Assertion
testPrettyExit :: TestTransport -> Assertion
testPrettyExit TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
`Ex.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
          Bool
True <- 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
$ (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 ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
done

testExitLocal :: TestTransport -> Assertion
testExitLocal :: TestTransport -> Assertion
testExitLocal TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
  -- XXX: we guarantee that exception handler will be set up
  -- regardless if forkProcess preserve masking state or not.
  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
        -- TODO: should verify that 'from' has the right value
        Bool
True <- 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 ()

  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"
    -- This time the client catches the exception, so it dies normally
    ProcessMonitorNotification MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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 ()

  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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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 ()) -- block forever
      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
        -- TODO: should verify that 'from' has the right value
        Bool
True <- 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 ()

  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 MonitorRef
ref' ProcessId
pid' DiedReason
DiedNormal <- Process ProcessMonitorNotification
forall a. Serializable a => Process a
expect
    Bool
True <- 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 ()

  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisedDone
  MVar () -> Assertion
forall a. MVar a -> IO a
takeMVar MVar ()
supervisorDone

testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend :: TestTransport -> Assertion
testUnsafeSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    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

testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend :: TestTransport -> Assertion
testUnsafeUSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    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

testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend :: TestTransport -> Assertion
testUnsafeNSend TestTransport{Transport
EndPointAddress -> EndPointAddress -> Assertion
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    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 ()

  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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    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
  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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
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
    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
testTransport :: TestTransport -> Transport
testBreakConnection :: TestTransport -> EndPointAddress -> EndPointAddress -> Assertion
testTransport :: Transport
testBreakConnection :: EndPointAddress -> EndPointAddress -> Assertion
..} = do
  LocalNode
node <- Transport -> RemoteTable -> IO LocalNode
newLocalNode Transport
testTransport RemoteTable
initRemoteTable

  -- Testing that (/=) <$> getSelfPid <*> callLocal getSelfPid.
  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
  Bool
True <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result
  () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Testing that when callLocal is interrupted, the worker is interrupted.
  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
Ex.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
Ex.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 ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Bool
True <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox
  () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Testing that when the worker raises an exception, the exception is propagated to the parent.
  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)
Ex.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
  Bool
True <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ibox
  () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Test that caller waits for the worker in correct situation
  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
`Ex.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 ()
  Bool
True <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result3
  () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Test that caller waits for the worker in case when caller gets an exception
  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
`Ex.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
`Ex.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!"
  Bool
True <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
result4
  () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- XXX: Testing that when mask_ $ callLocal p runs p in masked state.





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
"MergeChannels"       (TestTransport -> Assertion
testMergeChannels       TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Terminate"           (TestTransport -> Assertion
testTerminate           TestTransport
testtrans)
      , String -> Assertion -> Test
testCase String
"Registry"            (TestTransport -> Assertion
testRegistry            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
"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
"TextCallLocal"       (TestTransport -> Assertion
testCallLocal           TestTransport
testtrans)
      -- Unsafe Primitives
      , 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)
      -- usend
      , 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" [
      -- Monitoring processes
      --
      -- The "missing" combinations in the list below don't make much sense, as
      -- we cannot guarantee that the monitor reply or link exception will not
      -- happen before the unmonitor or unlink
      String -> Assertion -> Test
testCase String
"MonitorUnreachable"           (TestTransport -> Bool -> Bool -> Assertion
testMonitorUnreachable         TestTransport
testtrans Bool
True  Bool
False)
    , 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)
      -- Monitoring nodes and channels
    , 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)
      -- Reconnect
    , String -> Assertion -> Test
testCase String
"Reconnect"                    (TestTransport -> Assertion
testReconnect                  TestTransport
testtrans)
    ]
  ]

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 ()