Skip to content

Test if it's possible to send message to remote nodes in Registry #11

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jul 14, 2015
Merged

Test if it's possible to send message to remote nodes in Registry #11

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 46 additions & 0 deletions src/Control/Distributed/Process/Tests/CH.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -653,6 +653,26 @@ testRegistry TestTransport{..} = do

takeMVar done

testRegistryRemoteProcess :: TestTransport -> Assertion
testRegistryRemoteProcess TestTransport{..} = do
node1 <- newLocalNode testTransport initRemoteTable
node2 <- newLocalNode testTransport initRemoteTable
done <- newEmptyMVar

pingServer <- forkProcess node1 ping

runProcess node2 $ do
register "ping" pingServer
Just pid <- whereis "ping"
True <- return $ pingServer == pid
us <- getSelfPid
nsend "ping" (Pong us)
Ping pid' <- expect
True <- return $ pingServer == pid'
liftIO $ putMVar done ()

takeMVar done

testRemoteRegistry :: TestTransport -> Assertion
testRemoteRegistry TestTransport{..} = do
node1 <- newLocalNode testTransport initRemoteTable
Expand Down Expand Up @@ -697,6 +717,30 @@ testRemoteRegistry TestTransport{..} = do

takeMVar done

testRemoteRegistryRemoteProcess :: TestTransport -> Assertion
testRemoteRegistryRemoteProcess TestTransport{..} = do
node1 <- newLocalNode testTransport initRemoteTable
node2 <- newLocalNode testTransport initRemoteTable
done <- newEmptyMVar

pingServer <- forkProcess node2 ping

runProcess node2 $ do
let nid1 = localNodeId node1
registerRemoteAsync nid1 "ping" pingServer
receiveWait [
matchIf (\(RegisterReply label' _ _) -> "ping" == label')
(\(RegisterReply _ _ _) -> return ()) ]
Just pid <- whereisRemote nid1 "ping"
True <- return $ pingServer == pid
us <- getSelfPid
nsendRemote nid1 "ping" (Pong us)
Ping pid' <- expect
True <- return $ pingServer == pid'
liftIO $ putMVar done ()

takeMVar done

testSpawnLocal :: TestTransport -> Assertion
testSpawnLocal TestTransport{..} = do
node <- newLocalNode testTransport initRemoteTable
Expand Down Expand Up @@ -1368,7 +1412,9 @@ tests testtrans = return [
, testCase "MergeChannels" (testMergeChannels testtrans)
, testCase "Terminate" (testTerminate testtrans)
, testCase "Registry" (testRegistry testtrans)
, testCase "RegistryRemoteProcess" (testRegistryRemoteProcess testtrans)
, testCase "RemoteRegistry" (testRemoteRegistry testtrans)
, testCase "RemoteRegistryRemoteProcess" (testRemoteRegistryRemoteProcess testtrans)
, testCase "SpawnLocal" (testSpawnLocal testtrans)
, testCase "HandleMessageIf" (testHandleMessageIf testtrans)
, testCase "MatchAny" (testMatchAny testtrans)
Expand Down