@@ -1,4 +1,6 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ParallelListComp #-}
2module Control.Distributed.Process.Tests.Mx (tests) where
4module Control.Distributed.Process.Tests.Mx (tests) where
4import Control.Distributed.Process.Tests.Internal.Utils
6import Control.Distributed.Process.Tests.Internal.Utils
@@ -35,7 +37,7 @@ import Control.Monad (void, unless)
35import Control.Monad.Catch(finally, bracket, try)
37import Control.Monad.Catch(finally, bracket, try)
36import Control.Rematch (equalTo)
38import Control.Rematch (equalTo)
37import Data.Binary
39import Data.Binary
38−import Data.List (find, sort)
40+import Data.List (find, sort, intercalate)
39import Data.Maybe (isJust, fromJust, isNothing)
41import Data.Maybe (isJust, fromJust, isNothing)
40import Data.Typeable
42import Data.Typeable
41import GHC.Generics hiding (from)
43import GHC.Generics hiding (from)
@@ -412,7 +414,6 @@ tests :: TestTransport -> IO [Test]
412tests TestTransport{..} = do
414tests TestTransport{..} = do
413 node1 <- newLocalNode testTransport initRemoteTable
415 node1 <- newLocalNode testTransport initRemoteTable
414 node2 <- newLocalNode testTransport initRemoteTable
416 node2 <- newLocalNode testTransport initRemoteTable
415− let nid = localNodeId node2
417 testGroup "MxAgents" [
418 testGroup "MxAgents" [
418 testCase "EventHandling"
419 testCase "EventHandling"
@@ -447,65 +448,40 @@ tests TestTransport{..} = do
447 (delayedAssertion
448 (delayedAssertion
448 "expected process deaths to result in unregistration events"
449 "expected process deaths to result in unregistration events"
449 node1 () (testMxRegMon node2))
450 node1 () (testMxRegMon node2))
450− , testGroup "SentEvents" [
451+ , testGroup "SendEvents" $ buildTestCases node1 node2
451− testGroup "RemoteTargets" [
452+ ]
452− testCase "Unsafe.nsend"
453+ ]
453− (delayedAssertion "expected mx events failed"
454+ where
454− node1 True (testNSend Unsafe.nsend $ Just node2))
455+ buildTestCases n1 n2 =
455− , testCase "Unsafe.nsendRemote"
456+ let nid = localNodeId n2 in build n2 [
456− (delayedAssertion "expected mx events failed"
457+ ("NSend", [
457− node1 True (testNSend (Unsafe.nsendRemote nid) $ Just node2))
458+ ("Unsafe.nsend", testNSend Unsafe.nsend)
458− , testCase "Unsafe.send"
459+ , ("Unsafe.nsendRemote", testNSend (Unsafe.nsendRemote nid))
459− (delayedAssertion "expected mx events failed"
460+ , ("nsend", testNSend nsend)
460− node1 True (testSend Unsafe.send $ Just node2))
461+ , ("nsendRemote", testNSend (nsendRemote nid))
461− , testCase "Unsafe.usend"
462+ ])
462− (delayedAssertion "expected mx events failed"
463+ , ("Send", [
463− node1 True (testSend Unsafe.usend $ Just node2))
465− (delayedAssertion "expected mx events failed"
466− node1 True (testNSend nsend $ Just node2))
467− , testCase "nsendRemote"
468− (delayedAssertion "expected mx events failed"
469− node1 True (testNSend (nsendRemote nid) $ Just node2))
471− (delayedAssertion "expected mx events failed"
472− node1 True (testSend send $ Just node2))
474− (delayedAssertion "expected mx events failed"
475− node1 True (testSend usend $ Just node2))
476− , testCase "forward"
477− (delayedAssertion "expected mx events failed"
478− node1 True (testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p) $ Just node2))
479− , testCase "uforward"
480− (delayedAssertion "expected mx events failed"
481− node1 True (testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p) $ Just node2))
483− , testGroup "LocalTargets" [
484− testCase "Unsafe.nsend"
485− (delayedAssertion "expected mx events failed"
486− node1 True (testNSend Unsafe.nsend Nothing))
487− , testCase "Unsafe.send"
488− (delayedAssertion "expected mx events failed"
489− node1 True (testSend Unsafe.send Nothing))
490− , testCase "Unsafe.usend"
491− (delayedAssertion "expected mx events failed"
492− node1 True (testSend Unsafe.usend Nothing))
494− (delayedAssertion "expected mx events failed"
495− node1 True (testNSend nsend Nothing))
497− (delayedAssertion "expected mx events failed"
498− node1 True (testSend send Nothing))
464+ ("Unsafe.send", testSend Unsafe.send)
499− , testCase "usend"
465+ , ("Unsafe.usend", testSend Unsafe.usend)
500− (delayedAssertion "expected mx events failed"
466+ , ("send", testSend send)
501− node1 True (testSend usend Nothing))
467+ , ("usend", testSend usend)
502− , testCase "forward"
468+ ])
503− (delayedAssertion "expected mx events failed"
469+ , ("Forward", [
504− node1 True (testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p) Nothing))
470+ ("forward", testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p))
505− , testCase "uforward"
506− (delayedAssertion "expected mx events failed"
507− node1 True (testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p) Nothing))
471+ , ("uforward", testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p))
510− ]
475+ build :: LocalNode
476+ -> [(String, [(String, (Maybe LocalNode -> TestResult Bool -> Process ()))])]
479+ [ testGroup (intercalate "-" [groupName, caseSuffix]) [
480+ testCase (intercalate "-" [caseName, caseSuffix])
481+ (delayedAssertion "expected mx events failed"
482+ ln True (caseImpl caseNode))
483+ | (caseName, caseImpl) <- groupCases
485+ | (groupName, groupCases) <- specs
486+ , (caseSuffix, caseNode) <- [("RemotePid", Just ln), ("LocalPid", Nothing)]