git.iko.soy/distributed-process
on master help sign in
test remove getProcessInfo calls
1825b0cTim Watson
distributed-process/distributed-process.cabal+1
compare with master
unifiedsplit
@@ -132,6 +132,7 @@ Test-Suite TestStats
132 random >= 1.0 && < 1.1,
132 random >= 1.0 && < 1.1,
133 ansi-terminal >= 0.5 && < 0.6,
133 ansi-terminal >= 0.5 && < 0.6,
134 containers >= 0.4 && < 0.6,
134 containers >= 0.4 && < 0.6,
135+ stm >= 2.3 && < 2.5,
135 distributed-process,
136 distributed-process,
136 network-transport >= 0.3 && < 0.4,
137 network-transport >= 0.3 && < 0.4,
137 network-transport-tcp >= 0.3 && < 0.4,
138 network-transport-tcp >= 0.3 && < 0.4,
distributed-process/tests/TestStats.hs+38−3
@@ -1,8 +1,8 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3module Main where
3module Main where
4
4
5−import Prelude hiding (catch)
5+import Prelude hiding (catch, log)
6import Test.Framework
6import Test.Framework
7 ( Test
7 ( Test
8 , defaultMain
8 , defaultMain
@@ -97,6 +97,40 @@ testLocalLiveProcessInfo result = do
97-- infoMessageQueueLength pInfo == Just 4 &&
97-- infoMessageQueueLength pInfo == Just 4 &&
98 infoRegisteredNames pInfo == ["foobar"]
98 infoRegisteredNames pInfo == ["foobar"]
99
99
100+testRemoteLiveProcessInfo :: LocalNode -> Assertion
101+testRemoteLiveProcessInfo node1 = do
102+ serverAddr <- liftIO $ newEmptyMVar :: IO (MVar ProcessId)
103+ liftIO $ launchRemote serverAddr
104+ serverPid <- liftIO $ takeMVar serverAddr
105+ withActiveRemote node1 $ \result -> do
106+ self <- getSelfPid
107+ link serverPid
108+ -- our send op shouldn't overtake link or monitor requests AFAICT
109+ -- so a little table tennis should get us synchronised properly
110+ send serverPid (self, "ping")
111+ "pong" <- expect
112+ pInfo <- getProcessInfo serverPid
113+ stash result $ pInfo /= Nothing
114+ where
115+ launchRemote :: MVar ProcessId -> IO ()
116+ launchRemote locMV = do
117+ node2 <- liftIO $ mkNode "8082"
118+ _ <- liftIO $ forkProcess node2 $ do
119+ self <- getSelfPid
120+ liftIO $ putMVar locMV self
121+ _ <- receiveWait [
122+ match (\(pid, "ping") -> send pid "pong")
123+ ]
124+ "stop" <- expect
125+ return ()
126+ return ()
127+
128+ withActiveRemote :: LocalNode
129+ -> ((TestResult Bool -> Process ()) -> Assertion)
130+ withActiveRemote n = do
131+ a <- delayedAssertion "getProcessInfo remotePid failed" n True
132+ return a
133+
100tests :: LocalNode -> IO [Test]
134tests :: LocalNode -> IO [Test]
101tests node1 = do
135tests node1 = do
102 return [
136 return [
@@ -109,6 +143,8 @@ tests node1 = do
109 (delayedAssertion
143 (delayedAssertion
110 "expected process-info to be correctly populated"
144 "expected process-info to be correctly populated"
111 node1 True testLocalLiveProcessInfo)
145 node1 True testLocalLiveProcessInfo)
146+ , testCase "testRemoveLiveProcessInfo"
147+ (testRemoteLiveProcessInfo node1)
112 ] ]
148 ] ]
113
149
114mkNode :: String -> IO LocalNode
150mkNode :: String -> IO LocalNode
@@ -124,4 +160,3 @@ main = do
124 defaultMain testData
160 defaultMain testData
125 closeLocalNode node1
161 closeLocalNode node1
126 return ()
162 return ()
127−