Skip to content

Commit

Permalink
Ported distributed-process-execution
Browse files Browse the repository at this point in the history
  • Loading branch information
@LaurentRDC
LaurentRDC committed Jan 8, 2025
1 parent 5b37b6a commit e81b319
Show file tree
Hide file tree
Showing 3 changed files with 18 additions and 68 deletions.
64 changes: 8 additions & 56 deletions packages/distributed-process-execution/distributed-process-execution.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,14 +45,10 @@ library
distributed-process-client-server >= 0.2.0 && < 0.3,
binary >= 0.8 && < 0.9,
deepseq >= 1.4 && < 1.7,
mtl,
containers >= 0.6 && < 0.8,
hashable >= 1.2.0.5 && < 1.6,
unordered-containers >= 0.2.3.0 && < 0.3,
fingertree < 0.2,
stm >= 2.4 && < 2.6,
time,
transformers
hs-source-dirs: src
exposed-modules:
Control.Distributed.Process.Execution,
Expand All @@ -69,38 +65,16 @@ library
test-suite ExchangeTests
import: warnings
type: exitcode-stdio-1.0
-- x-uses-tf: true
build-depends:
base >= 4.14 && < 5,
ansi-terminal >= 0.5 && < 1.2,
containers,
hashable,
unordered-containers >= 0.2.3.0 && < 0.3,
build-depends: base >= 4.14 && < 5,
distributed-process,
distributed-process-execution,
distributed-process-extras,
distributed-process-systest ^>= 0.4,
distributed-static,
bytestring,
data-accessor,
fingertree < 0.2,
network-transport >= 0.4 && < 0.6,
deepseq,
mtl,
network-transport-tcp >= 0.4 && < 0.9,
binary >= 0.8 && < 0.9,
network >= 2.3 && < 3.3,
HUnit >= 1.2 && < 2,
stm,
time,
test-framework >= 0.6 && < 0.9,
test-framework-hunit,
QuickCheck >= 2.4,
test-framework-quickcheck2,
transformers,
ghc-prim
hs-source-dirs:
tests
tasty >= 1.5 && <1.6,
tasty-hunit >=0.10 && <0.11,
hs-source-dirs: tests
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
main-is: TestExchange.hs
default-language: Haskell2010
Expand All @@ -109,38 +83,16 @@ test-suite ExchangeTests
test-suite MailboxTests
import: warnings
type: exitcode-stdio-1.0
-- x-uses-tf: true
build-depends:
base >= 4.14 && < 5,
ansi-terminal >= 0.5 && < 1.2,
containers,
hashable,
unordered-containers >= 0.2.3.0 && < 0.3,
build-depends: base >= 4.14 && < 5,
distributed-process,
distributed-process-execution,
distributed-process-extras,
distributed-process-systest ^>= 0.4,
distributed-static,
bytestring,
data-accessor,
fingertree < 0.2,
network-transport >= 0.4 && < 0.6,
deepseq,
mtl,
network-transport-tcp >= 0.4 && < 0.9,
binary >= 0.8 && < 0.9,
network >= 2.3 && < 3.3,
HUnit >= 1.2 && < 2,
stm,
time,
test-framework >= 0.6 && < 0.9,
test-framework-hunit,
QuickCheck >= 2.4,
test-framework-quickcheck2,
transformers,
ghc-prim
hs-source-dirs:
tests
tasty >= 1.5 && <1.6,
tasty-hunit >=0.10 && <0.11,
hs-source-dirs: tests
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
main-is: TestMailbox.hs
other-modules: MailboxTestFilters
Expand Down
11 changes: 5 additions & 6 deletions packages/distributed-process-execution/tests/TestExchange.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,9 +22,8 @@ import Control.Monad (void, forM, forever)
import Prelude hiding (drop)
import Network.Transport.TCP
import qualified Network.Transport as NT
import Test.Framework as TF (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit (assertEqual, assertBool)
import Test.Tasty (defaultMain, testGroup, TestTree)
import Test.Tasty.HUnit (assertEqual, assertBool, testCase)

testKeyBasedRouting :: TestResult Bool -> Process ()
testKeyBasedRouting result = do
Expand Down Expand Up @@ -158,10 +157,10 @@ myRemoteTable :: RemoteTable
myRemoteTable =
Control.Distributed.Process.Extras.__remoteTable initRemoteTable

tests :: NT.Transport -> IO [Test]
tests :: NT.Transport -> IO TestTree
tests transport = do
localNode <- newLocalNode transport myRemoteTable
return [
return $ testGroup "" [
testGroup "Event Manager"
[
testCase "Simple Event Handlers"
Expand All @@ -187,7 +186,7 @@ main :: IO ()
main = testMain $ tests

-- | Given a @builder@ function, make and run a test suite on a single transport
testMain :: (NT.Transport -> IO [Test]) -> IO ()
testMain :: (NT.Transport -> IO TestTree) -> IO ()
testMain builder = do
Right (transport, _) <- createTransportExposeInternals (defaultTCPAddr "127.0.0.1" "10501") defaultTCPParameters
testData <- builder transport
Expand Down
11 changes: 5 additions & 6 deletions packages/distributed-process-execution/tests/TestMailbox.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,9 +17,8 @@ import Prelude hiding (drop)

import Data.Maybe (catMaybes)

import Test.Framework as TF (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit (assertEqual)
import Test.Tasty (defaultMain, testGroup, TestTree)
import Test.Tasty.HUnit (assertEqual, testCase)

import qualified MailboxTestFilters (__remoteTable)
import MailboxTestFilters (myFilter, intFilter)
Expand Down Expand Up @@ -175,11 +174,11 @@ myRemoteTable =
Control.Distributed.Process.Extras.__remoteTable $
MailboxTestFilters.__remoteTable initRemoteTable

tests :: NT.Transport -> IO [Test]
tests :: NT.Transport -> IO TestTree
tests transport = do
{- verboseCheckWithResult stdArgs -}
localNode <- newLocalNode transport myRemoteTable
return [
return $ testGroup "" [
testGroup "Dequeue/Pop Ordering"
[
testCase "Queue Ordering"
Expand Down Expand Up @@ -253,7 +252,7 @@ main :: IO ()
main = testMain $ tests

-- | Given a @builder@ function, make and run a test suite on a single transport
testMain :: (NT.Transport -> IO [Test]) -> IO ()
testMain :: (NT.Transport -> IO TestTree) -> IO ()
testMain builder = do
Right (transport, _) <- createTransportExposeInternals (defaultTCPAddr "127.0.0.1" "10501") defaultTCPParameters
testData <- builder transport
Expand Down

0 comments on commit e81b319

Please sign in to comment.