@@ -12,6 +12,7 @@ import Control.Concurrent.MVar ( newEmptyMVar
1212import Control.Monad (replicateM_)
1313import Control.Monad.IO.Class (liftIO)
1414import Control.Exception (throwIO)
15+import Control.Applicative ((<$>))
1516import qualified Network.Transport as NT (Transport, closeEndPoint)
1617import Network.Transport.TCP (createTransport, defaultTCPParameters)
1718import Control.Distributed.Process
@@ -62,10 +63,14 @@ testPing transport = do
6263
6364 takeMVar clientDone
6465
66+-- | Monitor or link to a remote node
67+monitorOrLink :: Bool -> ProcessId -> Process (Maybe MonitorRef)
68+monitorOrLink True pid = Just <$> monitor pid
69+monitorOrLink False pid = link pid >> return Nothing
6570
6671-- | Monitor an unreachable node
67−testMonitorUnreachable :: NT.Transport -> IO ()
68−testMonitorUnreachable transport = do
72+testMonitorUnreachable :: NT.Transport -> Bool -> IO ()
73+testMonitorUnreachable transport mOrL = do
6974 deadProcess <- newEmptyMVar
7075 done <- newEmptyMVar
7176
@@ -78,18 +83,20 @@ testMonitorUnreachable transport = do
7883 forkIO $ do
7984 localNode <- newLocalNode transport
8085 theirAddr <- readMVar deadProcess
81− runProcess localNode $ do
82− ref <- monitor theirAddr
83− ProcessDied ref' pid DiedDisconnect <- expect
84− True <- return $ ref' == ref && pid == theirAddr
85− return ()
86− putMVar done ()
87−
86+ runProcess localNode $
87+ catch (do ref <- monitorOrLink mOrL theirAddr
88+ MonitorNotification ref' pid DiedDisconnect <- expect
89+ True <- return $ Just ref' == ref && pid == theirAddr && mOrL
90+ liftIO $ putMVar done ())
91+ (\(LinkException pid DiedDisconnect) -> do
92+ True <- return $ pid == theirAddr && not mOrL
93+ liftIO $ putMVar done ())
94+
8895 takeMVar done
8996
9097-- | Monitor a process which terminates normally
91−testMonitorNormalTermination :: NT.Transport -> IO ()
92−testMonitorNormalTermination transport = do
98+testMonitorNormalTermination :: NT.Transport -> Bool -> IO ()
99+testMonitorNormalTermination transport mOrL = do
93100 monitorSetup <- newEmptyMVar
94101 monitoredProcess <- newEmptyMVar
95102 done <- newEmptyMVar
@@ -103,24 +110,26 @@ testMonitorNormalTermination transport = do
103110 forkIO $ do
104111 localNode <- newLocalNode transport
105112 theirAddr <- readMVar monitoredProcess
106− runProcess localNode $ do
107− ref <- monitor theirAddr
108− liftIO $ do
109− -- Monitor is asynchronous, but we want to make sure the monitor has
110− -- been fully created before allowing the remote process to terminate,
111− -- otherwise we might get a different signal here
112− threadDelay 100000
113− putMVar monitorSetup ()
114− ProcessDied ref' pid DiedNormal <- expect
115− True <- return $ ref' == ref && pid == theirAddr
116− return ()
117− putMVar done ()
113+ runProcess localNode $
114+ catch (do ref <- monitorOrLink mOrL theirAddr
115+ liftIO $ do
116+ -- Monitor is asynchronous, but we want to make sure the monitor has
117+ -- been fully created before allowing the remote process to terminate,
118+ -- otherwise we might get a different signal here
119+ threadDelay 100000
120+ putMVar monitorSetup ()
121+ MonitorNotification ref' pid DiedNormal <- expect
122+ True <- return $ Just ref' == ref && pid == theirAddr && mOrL
123+ liftIO $ putMVar done ())
124+ (\(LinkException pid DiedNormal) -> do
125+ True <- return $ pid == theirAddr && not mOrL
126+ liftIO $ putMVar done ())
118127
119128 takeMVar done
120129
121130-- | Monitor a process which terminates abnormally
122−testMonitorAbnormalTermination :: NT.Transport -> IO ()
123−testMonitorAbnormalTermination transport = do
131+testMonitorAbnormalTermination :: NT.Transport -> Bool -> IO ()
132+testMonitorAbnormalTermination transport mOrL = do
124133 monitorSetup <- newEmptyMVar
125134 monitoredProcess <- newEmptyMVar
126135 done <- newEmptyMVar
@@ -137,24 +146,26 @@ testMonitorAbnormalTermination transport = do
137146 forkIO $ do
138147 localNode <- newLocalNode transport
139148 theirAddr <- readMVar monitoredProcess
140− runProcess localNode $ do
141− ref <- monitor theirAddr
142− liftIO $ do
143− -- Monitor is asynchronous, but we want to make sure the monitor has
144− -- been fully created before allowing the remote process to terminate,
145− -- otherwise we might get a different signal here
146− threadDelay 100000
147− putMVar monitorSetup ()
148− ProcessDied ref' pid (DiedException err') <- expect
149− True <- return $ ref' == ref && pid == theirAddr && err' == show err
150− return ()
151− putMVar done ()
149+ runProcess localNode $
150+ catch (do ref <- monitorOrLink mOrL theirAddr
151+ liftIO $ do
152+ -- Monitor is asynchronous, but we want to make sure the monitor has
153+ -- been fully created before allowing the remote process to terminate,
154+ -- otherwise we might get a different signal here
155+ threadDelay 100000
156+ putMVar monitorSetup ()
157+ MonitorNotification ref' pid (DiedException err') <- expect
158+ True <- return $ Just ref' == ref && pid == theirAddr && err' == show err && mOrL
159+ liftIO $ putMVar done ())
160+ (\(LinkException pid (DiedException err')) -> do
161+ True <- return $ pid == theirAddr && err' == show err && not mOrL
162+ liftIO $ putMVar done ())
152163
153164 takeMVar done
154165
155166-- | Monitor a local process that is already dead
156−testMonitorLocalDeadProcess :: NT.Transport -> IO ()
157−testMonitorLocalDeadProcess transport = do
167+testMonitorLocalDeadProcess :: NT.Transport -> Bool -> IO ()
168+testMonitorLocalDeadProcess transport mOrL = do
158169 processDead <- newEmptyMVar
159170 processAddr <- newEmptyMVar
160171 localNode <- newLocalNode transport
@@ -168,17 +179,19 @@ testMonitorLocalDeadProcess transport = do
168179 theirAddr <- readMVar processAddr
169180 readMVar processDead
170181 runProcess localNode $ do
171− ref <- monitor theirAddr
172− ProcessDied ref' pid DiedNoProc <- expect
173− True <- return $ ref' == ref && pid == theirAddr
174− return ()
175− putMVar done ()
182+ catch (do ref <- monitorOrLink mOrL theirAddr
183+ MonitorNotification ref' pid DiedNoProc <- expect
184+ True <- return $ Just ref' == ref && pid == theirAddr && mOrL
185+ liftIO $ putMVar done ())
186+ (\(LinkException pid DiedNoProc) -> do
187+ True <- return $ pid == theirAddr && not mOrL
188+ liftIO $ putMVar done ())
176189
177190 takeMVar done
178191
179192-- | Monitor a remote process that is already dead
180−testMonitorRemoteDeadProcess :: NT.Transport -> IO ()
181−testMonitorRemoteDeadProcess transport = do
193+testMonitorRemoteDeadProcess :: NT.Transport -> Bool -> IO ()
194+testMonitorRemoteDeadProcess transport mOrL = do
182195 processDead <- newEmptyMVar
183196 processAddr <- newEmptyMVar
184197 done <- newEmptyMVar
@@ -193,17 +206,19 @@ testMonitorRemoteDeadProcess transport = do
193206 theirAddr <- readMVar processAddr
194207 readMVar processDead
195208 runProcess localNode $ do
196− ref <- monitor theirAddr
197− ProcessDied ref' pid DiedNoProc <- expect
198− True <- return $ ref' == ref && pid == theirAddr
199− return ()
200− putMVar done ()
209+ catch (do ref <- monitorOrLink mOrL theirAddr
210+ MonitorNotification ref' pid DiedNoProc <- expect
211+ True <- return $ Just ref' == ref && pid == theirAddr && mOrL
212+ liftIO $ putMVar done ())
213+ (\(LinkException pid DiedNoProc) -> do
214+ True <- return $ pid == theirAddr && not mOrL
215+ liftIO $ putMVar done ())
201216
202217 takeMVar done
203218
204219-- | Monitor a process that becomes disconnected
205−testMonitorDisconnect :: NT.Transport -> IO ()
206−testMonitorDisconnect transport = do
220+testMonitorDisconnect :: NT.Transport -> Bool -> IO ()
221+testMonitorDisconnect transport mOrL = do
207222 processAddr <- newEmptyMVar
208223 monitorSetup <- newEmptyMVar
209224 done <- newEmptyMVar
@@ -219,13 +234,15 @@ testMonitorDisconnect transport = do
219234 localNode <- newLocalNode transport
220235 theirAddr <- readMVar processAddr
221236 runProcess localNode $ do
222− ref <- monitor theirAddr
223− liftIO $ threadDelay 100000 >> putMVar monitorSetup ()
224− ProcessDied ref' pid DiedDisconnect <- expect
225− True <- return $ ref' == ref && pid == theirAddr
226− return ()
227− putMVar done ()
228−
237+ catch (do ref <- monitorOrLink mOrL theirAddr
238+ liftIO $ threadDelay 100000 >> putMVar monitorSetup ()
239+ MonitorNotification ref' pid DiedDisconnect <- expect
240+ True <- return $ Just ref' == ref && pid == theirAddr && mOrL
241+ liftIO $ putMVar done ())
242+ (\(LinkException pid DiedDisconnect) -> do
243+ True <- return $ pid == theirAddr && not mOrL
244+ liftIO $ putMVar done ())
245+
229246 takeMVar done
230247
231248
@@ -336,12 +353,18 @@ main = do
336353 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
337354 runTests
338355 [ --("Ping", testPing transport)
339− ("MonitorUnreachable", testMonitorUnreachable transport)
340− , ("MonitorNormalTermination", testMonitorNormalTermination transport)
341− , ("MonitorAbnormalTermination", testMonitorAbnormalTermination transport)
342− , ("MonitorLocalDeadProcess", testMonitorLocalDeadProcess transport)
343− , ("MonitorRemoteDeadProcess", testMonitorRemoteDeadProcess transport)
344− , ("MonitorDisconnect", testMonitorDisconnect transport)
356+ ("MonitorUnreachable", testMonitorUnreachable transport True)
357+ , ("MonitorNormalTermination", testMonitorNormalTermination transport True)
358+ , ("MonitorAbnormalTermination", testMonitorAbnormalTermination transport True)
359+ , ("MonitorLocalDeadProcess", testMonitorLocalDeadProcess transport True)
360+ , ("MonitorRemoteDeadProcess", testMonitorRemoteDeadProcess transport True)
361+ , ("MonitorDisconnect", testMonitorDisconnect transport True)
362+ , ("LinkUnreachable", testMonitorUnreachable transport False)
363+ , ("LinkNormalTermination", testMonitorNormalTermination transport False)
364+ , ("LinkAbnormalTermination", testMonitorAbnormalTermination transport False)
365+ , ("LinkLocalDeadProcess", testMonitorLocalDeadProcess transport False)
366+ , ("LinkRemoteDeadProcess", testMonitorRemoteDeadProcess transport False)
367+ , ("LinkDisconnect", testMonitorDisconnect transport False)
345368 {-
346369 , ("Monitor2", testMonitor2 transport)
347370 , ("Monitor3", testMonitor3 transport)