diff --git a/distributed-process-tests.cabal b/distributed-process-tests.cabal --- a/distributed-process-tests.cabal +++ b/distributed-process-tests.cabal @@ -1,5 +1,5 @@ name: distributed-process-tests -version: 0.4.7 +version: 0.4.8 synopsis: Tests and test support tools for distributed-process. homepage: http://github.com/haskell-distributed/distributed-process/tree/master/distributed-process-tests description: Tests and test suite for Cloud Haskell libraries. @@ -31,8 +31,8 @@ bytestring >= 0.9 && < 0.12, distributed-process >= 0.6.0 && < 0.7, distributed-static, - HUnit >= 1.2 && < 1.4, - network-transport >= 0.4.1.0 && < 0.5, + HUnit >= 1.2 && < 1.6, + network-transport >= 0.4.1.0 && < 0.6, network >= 2.5 && < 2.7, random >= 1.0 && < 1.2, rematch >= 0.1.2.1, @@ -61,7 +61,7 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, + network-transport >= 0.4.1.0 && < 0.6, network-transport-inmemory >= 0.5, test-framework >= 0.6 && < 0.9 Extensions: CPP @@ -76,8 +76,8 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, - network-transport-tcp >= 0.5 && < 0.6, + network-transport >= 0.4.1.0 && < 0.6, + network-transport-tcp >= 0.5 && < 0.7, test-framework >= 0.6 && < 0.9 else Buildable: False @@ -93,7 +93,7 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, + network-transport >= 0.4.1.0 && < 0.6, network-transport-inmemory >= 0.5, test-framework >= 0.6 && < 0.9 Extensions: CPP @@ -107,7 +107,7 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, + network-transport >= 0.4.1.0 && < 0.6, network-transport-inmemory >= 0.5, test-framework >= 0.6 && < 0.9 Extensions: CPP @@ -122,7 +122,7 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, + network-transport >= 0.4.1.0 && < 0.6, network-transport-inmemory >= 0.5, test-framework >= 0.6 && < 0.9 Extensions: CPP @@ -136,7 +136,7 @@ Build-Depends: base >= 4.4 && < 5, distributed-process-tests, network >= 2.3 && < 2.7, - network-transport >= 0.4.1.0 && < 0.5, + network-transport >= 0.4.1.0 && < 0.6, network-transport-inmemory >= 0.5, test-framework >= 0.6 && < 0.9 Extensions: CPP diff --git a/src/Control/Distributed/Process/Tests/Mx.hs b/src/Control/Distributed/Process/Tests/Mx.hs --- a/src/Control/Distributed/Process/Tests/Mx.hs +++ b/src/Control/Distributed/Process/Tests/Mx.hs @@ -22,11 +22,6 @@ , mxNotify , mxBroadcast , mxGetId - , mxGet - , mxSet - , mxClear - , mxPurgeTable - , mxDropTable ) import Control.Monad (void) import Data.Binary @@ -180,61 +175,6 @@ stash result $ seenAlive && seenDead -testAgentPublication :: TestResult (Maybe Publish) -> Process () -testAgentPublication result = do - (syncChan, rp) <- newChan - let ourId = MxAgentId "publication-agent" - agentPid <- mxAgent ourId () [ - mxSink $ \() -> do - selfId <- mxGetId - liftMX $ mxSet selfId "publish" Publish >> sendChan syncChan () - mxReady - ] - - mxNotify () - () <- receiveChan rp - - stash result =<< mxGet ourId "publish" - - mref <- monitor agentPid - kill agentPid "finished" - receiveWait [ - matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mref) - ((\_ -> return ())) - ] - -testAgentTableClear :: Int -> TestResult (Maybe Int, Maybe Int) -> Process () -testAgentTableClear val result = - let tId = (MxAgentId "agent-1") - tKey = "key-1" in do - mxSet tId tKey val - get1 <- mxGet tId tKey - mxClear tId tKey - get2 <- mxGet tId tKey - stash result (get1, get2) - -testAgentTablePurge :: TestResult (Maybe Int) -> Process () -testAgentTablePurge result = - let tId = MxAgentId "agent-2" - tKey = "key-2" in do - mxSet tId tKey (12345 :: Int) - mxPurgeTable tId - stash result =<< mxGet tId tKey - -testAgentTableDelete :: Int - -> TestResult (Maybe Int, Maybe Int, Maybe Int) - -> Process () -testAgentTableDelete val result = - let tId = (MxAgentId "agent-3") - tKey = "key-3" in do - mxSet tId tKey val - get1 <- mxGet tId tKey - mxDropTable tId - get2 <- mxGet tId tKey - mxSet tId tKey val - get3 <- mxGet tId tKey - stash result (get1, get2, get3) - tests :: TestTransport -> IO [Test] tests TestTransport{..} = do node1 <- newLocalNode testTransport initRemoteTable @@ -262,25 +202,4 @@ node1 (sort ["first", "second", "third", "fourth", "fifth"]) testAgentPrioritisation) - ], - testGroup "Mx Global Properties" [ - testCase "Global Property Publication" - (delayedAssertion - "expected (Just Publish), but no table entry was found" - node1 (Just Publish) testAgentPublication) - , testCase "Clearing Global Properties" - (delayedAssertion - "expected (Just 1024, Nothing): invalid table entry found!" - node1 (Just 1024, Nothing) (testAgentTableClear 1024)) - , testCase "Purging Global Tables" - (delayedAssertion - "expected Nothing, but a table entry was found" - node1 Nothing testAgentTablePurge) - , testCase "Deleting and (Re)Creating Global Tables" - (delayedAssertion - "expected (Just 15, Nothing, Just 15): invalid table entry found!" - node1 (Just 15, Nothing, Just 15) (testAgentTableDelete 15)) - -- Wait for other tests to finish. - , testCase "Wait" $ - threadDelay 100000 - ]] + ]] diff --git a/tests/runTCP.hs b/tests/runTCP.hs --- a/tests/runTCP.hs +++ b/tests/runTCP.hs @@ -25,6 +25,7 @@ hSetBuffering stderr LineBuffering Right (transport, internals) <- createTransportExposeInternals "127.0.0.1" "8080" + (\sn -> ("127.0.0.1", sn)) defaultTCPParameters { transportConnectTimeout = Just 3000000 } ts <- tests TestTransport { testTransport = transport