@@ -4,10 +4,11 @@ module Main where
44import Prelude hiding (catch)
55#endif
66
7+
78import Data.Binary (Binary(..))
89import Data.Typeable (Typeable)
910import Data.Foldable (forM_)
10−import Control.Concurrent (forkIO, threadDelay)
11+import Control.Concurrent (forkIO, threadDelay, myThreadId, throwTo, ThreadId)
1112import Control.Concurrent.MVar
1213 ( MVar
1314 , newEmptyMVar
@@ -16,8 +17,9 @@ import Control.Concurrent.MVar
1617 , readMVar
1718 )
1819import Control.Monad (replicateM_, replicateM, forever)
19−import Control.Exception (throwIO)
20−import Control.Applicative ((<$>), (<*>))
20+import Control.Exception (SomeException, throwIO)
21+import qualified Control.Exception as Ex (catch)
22+import Control.Applicative ((<$>), (<*>), pure, (<|>))
2123import qualified Network.Transport as NT (Transport, closeEndPoint)
2224import Network.Socket (sClose)
2325import Network.Transport.TCP
@@ -32,7 +34,10 @@ import Control.Distributed.Process.Internal.Types
3234 )
3335import Control.Distributed.Process.Node
3436import Control.Distributed.Process.Serializable (Serializable)
35−import TestAuxiliary
37+
38+import Test.HUnit (Assertion)
39+import Test.Framework (Test, defaultMain, testGroup)
40+import Test.Framework.Providers.HUnit (testCase)
3641
3742newtype Ping = Ping ProcessId
3843 deriving (Typeable, Binary, Show)
@@ -40,6 +45,16 @@ newtype Ping = Ping ProcessId
4045newtype Pong = Pong ProcessId
4146 deriving (Typeable, Binary, Show)
4247
48+--------------------------------------------------------------------------------
49+-- Supporting definitions --
50+--------------------------------------------------------------------------------
51+
52+-- | Like fork, but throw exceptions in the child thread to the parent
53+forkTry :: IO () -> IO ThreadId
54+forkTry p = do
55+ tid <- myThreadId
56+ forkIO $ Ex.catch p (\e -> throwTo tid (e :: SomeException))
57+
4358-- | The ping server from the paper
4459ping :: Process ()
4560ping = do
@@ -55,35 +70,32 @@ whereisRemote nid string = do
5570 WhereIsReply _ mPid <- expect
5671 return mPid
5772
58−-- | Basic ping test
59−testPing :: NT.Transport -> IO ()
60−testPing transport = do
61− serverAddr <- newEmptyMVar
62− clientDone <- newEmptyMVar
63−
64− -- Server
65− forkIO $ do
66− localNode <- newLocalNode transport initRemoteTable
67− addr <- forkProcess localNode ping
68− putMVar serverAddr addr
69−
70− -- Client
71− forkIO $ do
72− localNode <- newLocalNode transport initRemoteTable
73− pingServer <- readMVar serverAddr
73+data Add = Add ProcessId Double Double deriving (Typeable)
74+data Divide = Divide ProcessId Double Double deriving (Typeable)
75+data DivByZero = DivByZero deriving (Typeable)
7476
75− let numPings = 10000
77+instance Binary Add where
78+ put (Add pid x y) = put pid >> put x >> put y
79+ get = Add <$> get <*> get <*> get
7680
77− runProcess localNode $ do
78− pid <- getSelfPid
79− replicateM_ numPings $ do
80− send pingServer (Pong pid)
81− Ping _ <- expect
82− return ()
81+instance Binary Divide where
82+ put (Divide pid x y) = put pid >> put x >> put y
83+ get = Divide <$> get <*> get <*> get
8384
84− putMVar clientDone ()
85+instance Binary DivByZero where
86+ put DivByZero = return ()
87+ get = return DivByZero
8588
86− takeMVar clientDone
89+-- The math server from the paper
90+math :: Process ()
91+math = do
92+ receiveWait
93+ [ match (\(Add pid x y) -> send pid (x + y))
94+ , matchIf (\(Divide _ _ y) -> y /= 0)
95+ (\(Divide pid x y) -> send pid (x / y))
96+ , match (\(Divide pid _ _) -> send pid DivByZero)
97+ ]
98+ math
8799
88100-- | Monitor or link to a remote node
89101monitorOrLink :: Bool -- ^ 'True' for monitor, 'False' for link
@@ -125,9 +137,42 @@ monitorTestProcess theirAddr mOrL un reason monitorSetup done =
125137 liftIO $ putMVar done ()
126138 )
127139
140+--------------------------------------------------------------------------------
141+-- The tests proper --
142+--------------------------------------------------------------------------------
143+
144+-- | Basic ping test
145+testPing :: NT.Transport -> Assertion
146+testPing transport = do
147+ serverAddr <- newEmptyMVar
148+ clientDone <- newEmptyMVar
149+
150+ -- Server
151+ forkIO $ do
152+ localNode <- newLocalNode transport initRemoteTable
153+ addr <- forkProcess localNode ping
154+ putMVar serverAddr addr
155+
156+ -- Client
157+ forkIO $ do
158+ localNode <- newLocalNode transport initRemoteTable
159+ pingServer <- readMVar serverAddr
160+
161+ let numPings = 10000
162+
163+ runProcess localNode $ do
164+ pid <- getSelfPid
165+ replicateM_ numPings $ do
166+ send pingServer (Pong pid)
167+ Ping _ <- expect
168+ return ()
169+
170+ putMVar clientDone ()
171+
172+ takeMVar clientDone
128173
129174-- | Monitor a process on an unreachable node
130−testMonitorUnreachable :: NT.Transport -> Bool -> Bool -> IO ()
175+testMonitorUnreachable :: NT.Transport -> Bool -> Bool -> Assertion
131176testMonitorUnreachable transport mOrL un = do
132177 deadProcess <- newEmptyMVar
133178 done <- newEmptyMVar
@@ -147,7 +192,7 @@ testMonitorUnreachable transport mOrL un = do
147192 takeMVar done
148193
149194-- | Monitor a process which terminates normally
150−testMonitorNormalTermination :: NT.Transport -> Bool -> Bool -> IO ()
195+testMonitorNormalTermination :: NT.Transport -> Bool -> Bool -> Assertion
151196testMonitorNormalTermination transport mOrL un = do
152197 monitorSetup <- newEmptyMVar
153198 monitoredProcess <- newEmptyMVar
@@ -168,7 +213,7 @@ testMonitorNormalTermination transport mOrL un = do
168213 takeMVar done
169214
170215-- | Monitor a process which terminates abnormally
171−testMonitorAbnormalTermination :: NT.Transport -> Bool -> Bool -> IO ()
216+testMonitorAbnormalTermination :: NT.Transport -> Bool -> Bool -> Assertion
172217testMonitorAbnormalTermination transport mOrL un = do
173218 monitorSetup <- newEmptyMVar
174219 monitoredProcess <- newEmptyMVar
@@ -192,7 +237,7 @@ testMonitorAbnormalTermination transport mOrL un = do
192237 takeMVar done
193238
194239-- | Monitor a local process that is already dead
195−testMonitorLocalDeadProcess :: NT.Transport -> Bool -> Bool -> IO ()
240+testMonitorLocalDeadProcess :: NT.Transport -> Bool -> Bool -> Assertion
196241testMonitorLocalDeadProcess transport mOrL un = do
197242 processDead <- newEmptyMVar
198243 processAddr <- newEmptyMVar
@@ -212,7 +257,7 @@ testMonitorLocalDeadProcess transport mOrL un = do
212257 takeMVar done
213258
214259-- | Monitor a remote process that is already dead
215−testMonitorRemoteDeadProcess :: NT.Transport -> Bool -> Bool -> IO ()
260+testMonitorRemoteDeadProcess :: NT.Transport -> Bool -> Bool -> Assertion
216261testMonitorRemoteDeadProcess transport mOrL un = do
217262 processDead <- newEmptyMVar
218263 processAddr <- newEmptyMVar
@@ -233,7 +278,7 @@ testMonitorRemoteDeadProcess transport mOrL un = do
233278 takeMVar done
234279
235280-- | Monitor a process that becomes disconnected
236−testMonitorDisconnect :: NT.Transport -> Bool -> Bool -> IO ()
281+testMonitorDisconnect :: NT.Transport -> Bool -> Bool -> Assertion
237282testMonitorDisconnect transport mOrL un = do
238283 processAddr <- newEmptyMVar
239284 monitorSetup <- newEmptyMVar
@@ -254,34 +299,8 @@ testMonitorDisconnect transport mOrL un = do
254299
255300 takeMVar done
256301
257−data Add = Add ProcessId Double Double deriving (Typeable)
258−data Divide = Divide ProcessId Double Double deriving (Typeable)
259−data DivByZero = DivByZero deriving (Typeable)
260−
261−instance Binary Add where
262− put (Add pid x y) = put pid >> put x >> put y
263− get = Add <$> get <*> get <*> get
264−
265−instance Binary Divide where
266− put (Divide pid x y) = put pid >> put x >> put y
267− get = Divide <$> get <*> get <*> get
268−
269−instance Binary DivByZero where
270− put DivByZero = return ()
271− get = return DivByZero
272−
273−math :: Process ()
274−math = do
275− receiveWait
276− [ match (\(Add pid x y) -> send pid (x + y))
277− , matchIf (\(Divide _ _ y) -> y /= 0)
278− (\(Divide pid x y) -> send pid (x / y))
279− , match (\(Divide pid _ _) -> send pid DivByZero)
280− ]
281− math
282−
283302-- | Test the math server (i.e., receiveWait)
284−testMath :: NT.Transport -> IO ()
303+testMath :: NT.Transport -> Assertion
285304testMath transport = do
286305 serverAddr <- newEmptyMVar
287306 clientDone <- newEmptyMVar
@@ -312,7 +331,7 @@ testMath transport = do
312331-- | Send first message (i.e. connect) to an already terminated process
313332-- (without monitoring); then send another message to a second process on
314333-- the same remote node (we're checking that the remote node did not die)
315−testSendToTerminated :: NT.Transport -> IO ()
334+testSendToTerminated :: NT.Transport -> Assertion
316335testSendToTerminated transport = do
317336 serverAddr1 <- newEmptyMVar
318337 serverAddr2 <- newEmptyMVar
@@ -342,7 +361,7 @@ testSendToTerminated transport = do
342361 takeMVar clientDone
343362
344363-- | Test (non-zero) timeout
345−testTimeout :: NT.Transport -> IO ()
364+testTimeout :: NT.Transport -> Assertion
346365testTimeout transport = do
347366 localNode <- newLocalNode transport initRemoteTable
348367 runProcess localNode $ do
@@ -350,7 +369,7 @@ testTimeout transport = do
350369 return ()
351370
352371-- | Test zero timeout
353−testTimeout0 :: NT.Transport -> IO ()
372+testTimeout0 :: NT.Transport -> Assertion
354373testTimeout0 transport = do
355374 serverAddr <- newEmptyMVar
356375 clientDone <- newEmptyMVar
@@ -384,7 +403,7 @@ testTimeout0 transport = do
384403 takeMVar clientDone
385404
386405-- | Test typed channels
387−testTypedChannels :: NT.Transport -> IO ()
406+testTypedChannels :: NT.Transport -> Assertion
388407testTypedChannels transport = do
389408 serverChannel <- newEmptyMVar :: IO (MVar (SendPort (SendPort Bool, Int)))
390409 clientDone <- newEmptyMVar
@@ -410,7 +429,7 @@ testTypedChannels transport = do
410429 takeMVar clientDone
411430
412431-- | Test merging receive ports
413−testMergeChannels :: NT.Transport -> IO ()
432+testMergeChannels :: NT.Transport -> Assertion
414433testMergeChannels transport = do
415434 localNode <- newLocalNode transport initRemoteTable
416435 testFlat localNode True "aaabbbccc"
@@ -424,29 +443,34 @@ testMergeChannels transport = do
424443 where
425444 -- Single layer of merging
426445 testFlat :: LocalNode -> Bool -> String -> IO ()
427− testFlat localNode biased expected =
428− runProcess localNode $ do
446+ testFlat localNode biased expected = do
447+ done <- newEmptyMVar
448+ forkProcess localNode $ do
429449 rs <- mapM charChannel "abc"
430450 m <- mergePorts biased rs
431451 xs <- replicateM 9 $ receiveChan m
432452 True <- return $ xs == expected
433− return ()
453+ liftIO $ putMVar done ()
454+ takeMVar done
434455
435456 -- Two layers of merging
436457 testNested :: LocalNode -> Bool -> Bool -> String -> IO ()
437− testNested localNode biasedInner biasedOuter expected =
438− runProcess localNode $ do
458+ testNested localNode biasedInner biasedOuter expected = do
459+ done <- newEmptyMVar
460+ forkProcess localNode $ do
439461 rss <- mapM (mapM charChannel) ["abc", "def", "ghi"]
440462 ms <- mapM (mergePorts biasedInner) rss
441463 m <- mergePorts biasedOuter ms
442464 xs <- replicateM (9 * 3) $ receiveChan m
443465 True <- return $ xs == expected
444− return ()
466+ liftIO $ putMVar done ()
467+ takeMVar done
445468
446469 -- Test that if no messages are (immediately) available, the scheduler makes no difference
447470 testBlocked :: LocalNode -> Bool -> IO ()
448471 testBlocked localNode biased = do
449472 vs <- replicateM 3 newEmptyMVar
473+ done <- newEmptyMVar
450474
451475 forkProcess localNode $ do
452476 [sa, sb, sc] <- liftIO $ mapM readMVar vs
@@ -477,13 +501,15 @@ testMergeChannels transport = do
477501 , (sa, 'a')
478502 ]
479503
480− runProcess localNode $ do
504+ forkProcess localNode $ do
481505 (ss, rs) <- unzip <$> replicateM 3 newChan
482506 liftIO $ mapM_ (uncurry putMVar) $ zip vs ss
483507 m <- mergePorts biased rs
484508 xs <- replicateM (6 * 3) $ receiveChan m
485509 True <- return $ xs == "abcacbbacbcacabcba"
486− return ()
510+ liftIO $ putMVar done ()
511+
512+ takeMVar done
487513
488514 mergePorts :: Serializable a => Bool -> [ReceivePort a] -> Process (ReceivePort a)
489515 mergePorts True = mergePortsBiased
@@ -496,7 +522,7 @@ testMergeChannels transport = do
496522 liftIO $ threadDelay 10000 -- Make sure messages have been sent
497523 return rport
498524
499−testTerminate :: NT.Transport -> IO ()
525+testTerminate :: NT.Transport -> Assertion
500526testTerminate transport = do
501527 localNode <- newLocalNode transport initRemoteTable
502528
@@ -510,7 +536,7 @@ testTerminate transport = do
510536 True <- return $ ref == ref' && pid == pid' && ex == show ProcessTerminationException
511537 return ()
512538
513−testMonitorNode :: NT.Transport -> IO ()
539+testMonitorNode :: NT.Transport -> Assertion
514540testMonitorNode transport = do
515541 [node1, node2] <- replicateM 2 $ newLocalNode transport initRemoteTable
516542
@@ -522,7 +548,7 @@ testMonitorNode transport = do
522548 True <- return $ ref == ref' && nid == localNodeId node1
523549 return ()
524550
525−testMonitorChannel :: NT.Transport -> IO ()
551+testMonitorChannel :: NT.Transport -> Assertion
526552testMonitorChannel transport = do
527553 [node1, node2] <- replicateM 2 $ newLocalNode transport initRemoteTable
528554 gotNotification <- newEmptyMVar
@@ -543,7 +569,7 @@ testMonitorChannel transport = do
543569
544570 takeMVar gotNotification
545571
546−testRegistry :: NT.Transport -> IO ()
572+testRegistry :: NT.Transport -> Assertion
547573testRegistry transport = do
548574 node <- newLocalNode transport initRemoteTable
549575
@@ -559,7 +585,7 @@ testRegistry transport = do
559585 True <- return $ pingServer == pid'
560586 return ()
561587
562−testRemoteRegistry :: NT.Transport -> IO ()
588+testRemoteRegistry :: NT.Transport -> Assertion
563589testRemoteRegistry transport = do
564590 node1 <- newLocalNode transport initRemoteTable
565591 node2 <- newLocalNode transport initRemoteTable
@@ -577,7 +603,7 @@ testRemoteRegistry transport = do
577603 True <- return $ pingServer == pid'
578604 return ()
579605
580−testSpawnLocal :: NT.Transport -> IO ()
606+testSpawnLocal :: NT.Transport -> Assertion
581607testSpawnLocal transport = do
582608 node <- newLocalNode transport initRemoteTable
583609
@@ -595,7 +621,7 @@ testSpawnLocal transport = do
595621 send pid sport
596622 expect
597623
598−testReconnect :: NT.Transport -> TransportInternals -> IO ()
624+testReconnect :: NT.Transport -> TransportInternals -> Assertion
599625testReconnect transport transportInternals = do
600626 [node1, node2] <- replicateM 2 $ newLocalNode transport initRemoteTable
601627 let nid1 = localNodeId node1
@@ -664,7 +690,7 @@ testReconnect transport transportInternals = do
664690
665691-- | Test 'matchAny'. This repeats the 'testMath' but with a proxy server
666692-- in between
667−testMatchAny :: NT.Transport -> IO ()
693+testMatchAny :: NT.Transport -> Assertion
668694testMatchAny transport = do
669695 proxyAddr <- newEmptyMVar
670696 clientDone <- newEmptyMVar
@@ -695,48 +721,157 @@ testMatchAny transport = do
695721
696722 takeMVar clientDone
697723
698−main :: IO ()
699−main = do
700− Right (transport, transportInternals) <- createTransportExposeInternals "127.0.0.1" "8080" defaultTCPParameters
701− runTests
702− [ ("Ping", testPing transport)
703− , ("Math", testMath transport)
704− , ("Timeout", testTimeout transport)
705− , ("Timeout0", testTimeout0 transport)
706− , ("SendToTerminated", testSendToTerminated transport)
707− , ("TypedChannnels", testTypedChannels transport)
708− , ("MergeChannels", testMergeChannels transport)
709− , ("Terminate", testTerminate transport)
710− , ("Registry", testRegistry transport)
711− , ("RemoteRegistry", testRemoteRegistry transport)
712− , ("SpawnLocal", testSpawnLocal transport)
713− , ("MatchAny", testMatchAny transport)
724+-- Test 'receiveChanTimeout'
725+testReceiveChanTimeout :: NT.Transport -> Assertion
726+testReceiveChanTimeout transport = do
727+ done <- newEmptyMVar
728+ sendPort <- newEmptyMVar
729+
730+ forkTry $ do
731+ localNode <- newLocalNode transport initRemoteTable
732+ runProcess localNode $ do
733+ -- Create a typed channel
734+ (sp, rp) <- newChan :: Process (SendPort Bool, ReceivePort Bool)
735+ liftIO $ putMVar sendPort sp
736+
737+ -- Wait for a message with a delay. No message arrives, we should get Nothing after 1 second
738+ Nothing <- receiveChanTimeout 1000000 rp
739+
740+ -- Wait for a message with a delay again. Now a message arrives after 0.5 seconds
741+ Just True <- receiveChanTimeout 1000000 rp
742+
743+ -- Wait for a message with zero timeout: non-blocking check. No message is available, we get Nothing
744+ Nothing <- receiveChanTimeout 0 rp
745+
746+ -- Again, but now there is a message available
747+ liftIO $ threadDelay 1000000
748+ Just False <- receiveChanTimeout 0 rp
749+
750+ liftIO $ putMVar done ()
751+
752+ forkTry $ do
753+ localNode <- newLocalNode transport initRemoteTable
754+ runProcess localNode $ do
755+ sp <- liftIO $ readMVar sendPort
756+
757+ liftIO $ threadDelay 1500000
758+ sendChan sp True
759+
760+ liftIO $ threadDelay 500000
761+ sendChan sp False
762+
763+ takeMVar done
764+
765+-- | Test Functor, Applicative, Alternative and Monad instances for ReceiveChan
766+testReceiveChanFeatures :: NT.Transport -> Assertion
767+testReceiveChanFeatures transport = do
768+ done <- newEmptyMVar
769+
770+ forkTry $ do
771+ localNode <- newLocalNode transport initRemoteTable
772+ runProcess localNode $ do
773+ (spInt, rpInt) <- newChan :: Process (SendPort Int, ReceivePort Int)
774+ (spBool, rpBool) <- newChan :: Process (SendPort Bool, ReceivePort Bool)
775+
776+ -- Test Functor instance
777+
778+ sendChan spInt 2
779+ sendChan spBool False
780+
781+ rp1 <- mergePortsBiased [even <$> rpInt, rpBool]
782+
783+ True <- receiveChan rp1
784+ False <- receiveChan rp1
785+
786+ -- Test Applicative instance
787+
788+ sendChan spInt 3
789+ sendChan spInt 4
790+
791+ let rp2 = pure (+) <*> rpInt <*> rpInt
792+
793+ 7 <- receiveChan rp2
794+
795+ -- Test Alternative instance
796+
797+ sendChan spInt 3
798+ sendChan spBool True
799+
800+ let rp3 = (even <$> rpInt) <|> rpBool
801+
802+ False <- receiveChan rp3
803+ True <- receiveChan rp3
804+
805+ -- Test Monad instance
806+
807+ sendChan spBool True
808+ sendChan spBool False
809+ sendChan spInt 5
810+
811+ let rp4 :: ReceivePort Int
812+ rp4 = do b <- rpBool
813+ if b
814+ then rpInt
815+ else return 7
816+
817+ 5 <- receiveChan rp4
818+ 7 <- receiveChan rp4
819+
820+ liftIO $ putMVar done ()
821+
822+ takeMVar done
823+
824+tests :: (NT.Transport, TransportInternals) -> [Test]
825+tests (transport, transportInternals) = [
826+ testGroup "Basic features" [
827+ testCase "Ping" (testPing transport)
828+ , testCase "Math" (testMath transport)
829+ , testCase "Timeout" (testTimeout transport)
830+ , testCase "Timeout0" (testTimeout0 transport)
831+ , testCase "SendToTerminated" (testSendToTerminated transport)
832+ , testCase "TypedChannnels" (testTypedChannels transport)
833+ , testCase "MergeChannels" (testMergeChannels transport)
834+ , testCase "Terminate" (testTerminate transport)
835+ , testCase "Registry" (testRegistry transport)
836+ , testCase "RemoteRegistry" (testRemoteRegistry transport)
837+ , testCase "SpawnLocal" (testSpawnLocal transport)
838+ , testCase "MatchAny" (testMatchAny transport)
839+ , testCase "ReceiveChanTimeout" (testReceiveChanTimeout transport)
840+ , testCase "ReceiveChanFeatures" (testReceiveChanFeatures transport)
841+ ]
842+ , testGroup "Monitoring and Linking" [
714843 -- Monitoring processes
715844 --
716845 -- The "missing" combinations in the list below don't make much sense, as
717846 -- we cannot guarantee that the monitor reply or link exception will not
718847 -- happen before the unmonitor or unlink
719− , ("MonitorUnreachable", testMonitorUnreachable transport True False)
720− , ("MonitorNormalTermination", testMonitorNormalTermination transport True False)
721− , ("MonitorAbnormalTermination", testMonitorAbnormalTermination transport True False)
722− , ("MonitorLocalDeadProcess", testMonitorLocalDeadProcess transport True False)
723− , ("MonitorRemoteDeadProcess", testMonitorRemoteDeadProcess transport True False)
724− , ("MonitorDisconnect", testMonitorDisconnect transport True False)
725− , ("LinkUnreachable", testMonitorUnreachable transport False False)
726− , ("LinkNormalTermination", testMonitorNormalTermination transport False False)
727− , ("LinkAbnormalTermination", testMonitorAbnormalTermination transport False False)
728− , ("LinkLocalDeadProcess", testMonitorLocalDeadProcess transport False False)
729− , ("LinkRemoteDeadProcess", testMonitorRemoteDeadProcess transport False False)
730− , ("LinkDisconnect", testMonitorDisconnect transport False False)
731− , ("UnmonitorNormalTermination", testMonitorNormalTermination transport True True)
732− , ("UnmonitorAbnormalTermination", testMonitorAbnormalTermination transport True True)
733− , ("UnmonitorDisconnect", testMonitorDisconnect transport True True)
734− , ("UnlinkNormalTermination", testMonitorNormalTermination transport False True)
735− , ("UnlinkAbnormalTermination", testMonitorAbnormalTermination transport False True)
736− , ("UnlinkDisconnect", testMonitorDisconnect transport False True)
848+ testCase "MonitorUnreachable" (testMonitorUnreachable transport True False)
849+ , testCase "MonitorNormalTermination" (testMonitorNormalTermination transport True False)
850+ , testCase "MonitorAbnormalTermination" (testMonitorAbnormalTermination transport True False)
851+ , testCase "MonitorLocalDeadProcess" (testMonitorLocalDeadProcess transport True False)
852+ , testCase "MonitorRemoteDeadProcess" (testMonitorRemoteDeadProcess transport True False)
853+ , testCase "MonitorDisconnect" (testMonitorDisconnect transport True False)
854+ , testCase "LinkUnreachable" (testMonitorUnreachable transport False False)
855+ , testCase "LinkNormalTermination" (testMonitorNormalTermination transport False False)
856+ , testCase "LinkAbnormalTermination" (testMonitorAbnormalTermination transport False False)
857+ , testCase "LinkLocalDeadProcess" (testMonitorLocalDeadProcess transport False False)
858+ , testCase "LinkRemoteDeadProcess" (testMonitorRemoteDeadProcess transport False False)
859+ , testCase "LinkDisconnect" (testMonitorDisconnect transport False False)
860+ , testCase "UnmonitorNormalTermination" (testMonitorNormalTermination transport True True)
861+ , testCase "UnmonitorAbnormalTermination" (testMonitorAbnormalTermination transport True True)
862+ , testCase "UnmonitorDisconnect" (testMonitorDisconnect transport True True)
863+ , testCase "UnlinkNormalTermination" (testMonitorNormalTermination transport False True)
864+ , testCase "UnlinkAbnormalTermination" (testMonitorAbnormalTermination transport False True)
865+ , testCase "UnlinkDisconnect" (testMonitorDisconnect transport False True)
737866 -- Monitoring nodes and channels
738− , ("MonitorNode", testMonitorNode transport)
739− , ("MonitorChannel", testMonitorChannel transport)
867+ , testCase "MonitorNode" (testMonitorNode transport)
868+ , testCase "MonitorChannel" (testMonitorChannel transport)
740869 -- Reconnect
741− , ("Reconnect", testReconnect transport transportInternals)
870+ , testCase "Reconnect" (testReconnect transport transportInternals)
742871 ]
872+ ]
873+
874+main :: IO ()
875+main = do
876+ Right transport <- createTransportExposeInternals "127.0.0.1" "8080" defaultTCPParameters
877+ defaultMain (tests transport)