git.iko.soy/distributed-process
on master help sign in
tidy up test case generation
commita5191ce0650063a75be59de61e479208e82a0c7d authorTim Watson <watson.timothy@gmail.com> dateTue 20 Nov 2018, 23:12 (8 years ago) parent5fc844f
2 files changed+40−64
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+39−63 stack-ghc-7.10.3.yaml+1−1
distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs+39−63
@@ -1,4 +1,6 @@
1−{-# LANGUAGE DeriveGeneric #-}
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE ParallelListComp #-}
3+
24module Control.Distributed.Process.Tests.Mx (tests) where
35
46import Control.Distributed.Process.Tests.Internal.Utils
@@ -35,7 +37,7 @@ import Control.Monad (void, unless)
3537import Control.Monad.Catch(finally, bracket, try)
3638import Control.Rematch (equalTo)
3739import Data.Binary
38−import Data.List (find, sort)
40+import Data.List (find, sort, intercalate)
3941import Data.Maybe (isJust, fromJust, isNothing)
4042import Data.Typeable
4143import GHC.Generics hiding (from)
@@ -412,7 +414,6 @@ tests :: TestTransport -> IO [Test]
412414tests TestTransport{..} = do
413415 node1 <- newLocalNode testTransport initRemoteTable
414416 node2 <- newLocalNode testTransport initRemoteTable
415− let nid = localNodeId node2
416417 return [
417418 testGroup "MxAgents" [
418419 testCase "EventHandling"
@@ -447,65 +448,40 @@ tests TestTransport{..} = do
447448 (delayedAssertion
448449 "expected process deaths to result in unregistration events"
449450 node1 () (testMxRegMon node2))
450− , testGroup "SentEvents" [
451− testGroup "RemoteTargets" [
452− testCase "Unsafe.nsend"
453− (delayedAssertion "expected mx events failed"
454− node1 True (testNSend Unsafe.nsend $ Just node2))
455− , testCase "Unsafe.nsendRemote"
456− (delayedAssertion "expected mx events failed"
457− node1 True (testNSend (Unsafe.nsendRemote nid) $ Just node2))
458− , testCase "Unsafe.send"
459− (delayedAssertion "expected mx events failed"
460− node1 True (testSend Unsafe.send $ Just node2))
461− , testCase "Unsafe.usend"
462− (delayedAssertion "expected mx events failed"
463− node1 True (testSend Unsafe.usend $ Just node2))
464− , testCase "nsend"
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))
470− , testCase "send"
471− (delayedAssertion "expected mx events failed"
472− node1 True (testSend send $ Just node2))
473− , testCase "usend"
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))
482− ]
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))
493− , testCase "nsend"
494− (delayedAssertion "expected mx events failed"
495− node1 True (testNSend nsend Nothing))
496− , testCase "send"
497− (delayedAssertion "expected mx events failed"
498− node1 True (testSend send Nothing))
499− , testCase "usend"
500− (delayedAssertion "expected mx events failed"
501− node1 True (testSend usend Nothing))
502− , testCase "forward"
503− (delayedAssertion "expected mx events failed"
504− node1 True (testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p) Nothing))
505− , testCase "uforward"
506− (delayedAssertion "expected mx events failed"
507− node1 True (testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p) Nothing))
451+ , testGroup "SendEvents" $ buildTestCases node1 node2
452+ ]
453+ ]
454+ where
455+ buildTestCases n1 n2 =
456+ let nid = localNodeId n2 in build n2 [
457+ ("NSend", [
458+ ("Unsafe.nsend", testNSend Unsafe.nsend)
459+ , ("Unsafe.nsendRemote", testNSend (Unsafe.nsendRemote nid))
460+ , ("nsend", testNSend nsend)
461+ , ("nsendRemote", testNSend (nsendRemote nid))
462+ ])
463+ , ("Send", [
464+ ("Unsafe.send", testSend Unsafe.send)
465+ , ("Unsafe.usend", testSend Unsafe.usend)
466+ , ("send", testSend send)
467+ , ("usend", testSend usend)
468+ ])
469+ , ("Forward", [
470+ ("forward", testSend (\p m -> forward (unsafeCreateUnencodedMessage m) p))
471+ , ("uforward", testSend (\p m -> uforward (unsafeCreateUnencodedMessage m) p))
472+ ])
508473 ]
509− ]
510− ]
474+
475+ build :: LocalNode
476+ -> [(String, [(String, (Maybe LocalNode -> TestResult Bool -> Process ()))])]
477+ -> [Test]
478+ build ln specs =
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
484+ ]
485+ | (groupName, groupCases) <- specs
486+ , (caseSuffix, caseNode) <- [("RemotePid", Just ln), ("LocalPid", Nothing)]
511487 ]
stack-ghc-7.10.3.yaml+1−1
@@ -14,7 +14,7 @@ extra-deps:
1414- network-transport-0.5.2
1515- network-transport-inmemory-0.5.2
1616- rematch-0.2.0.0
17−- exceptions-0.8.2.1
17+- exceptions-0.8.2.1 # test dependency
1818
1919flags:
2020 distributed-process-tests: