Ported distributed-process-tests

haskell-distributed · Jan 8, 2025 · ecec015 · ecec015
1 parent e81b319
commit ecec015
Show file tree

Hide file tree

Showing 10 changed files with 43 additions and 76 deletions.
diff --git a/packages/distributed-process-tests/distributed-process-tests.cabal b/packages/distributed-process-tests/distributed-process-tests.cabal
@@ -30,6 +30,7 @@ common warnings
                  -Wredundant-constraints
                  -fhide-source-paths
                  -Wpartial-fields
+                 -Wunused-packages
 
 library
   import:            warnings
@@ -42,19 +43,16 @@ library
                      Control.Distributed.Process.Tests.Tracing
                      Control.Distributed.Process.Tests.Internal.Utils
   Build-Depends:     base >= 4.14 && < 5,
-                     ansi-terminal >= 0.5,
                      binary >= 0.8 && < 0.9,
                      bytestring >= 0.10 && < 0.13,
                      distributed-process >= 0.6.0 && < 0.8,
                      distributed-static,
                      exceptions >= 0.10,
-                     HUnit >= 1.2 && < 1.7,
                      network-transport >= 0.4.1.0 && < 0.6,
-                     network >= 2.5 && < 3.3,
                      random >= 1.0 && < 1.4,
                      setenv >= 0.1.1.3,
-                     test-framework >= 0.6 && < 0.9,
-                     test-framework-hunit >= 0.2.0 && < 0.4,
+                     tasty >= 1.5 && <1.6,
+                     tasty-hunit >=0.10 && <0.11,
                      stm
   hs-source-dirs:    src
   default-language:  Haskell98
@@ -76,10 +74,8 @@ Test-Suite TestCHInMemory
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.CH
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -93,10 +89,9 @@ Test-Suite TestCHInTCP
   if flag(tcp)
     Build-Depends:     base >= 4.14 && < 5,
                        distributed-process-tests,
-                       network >= 2.5 && < 3.2,
-                       network-transport >= 0.4.1.0 && < 0.6,
+                       network >= 2.3 && < 3.3,
                        network-transport-tcp >= 0.5 && < 0.9,
-                       test-framework >= 0.6 && < 0.9
+                       tasty >= 1.5 && <1.6,
   else
     Buildable:       False
   default-extensions: CPP
@@ -112,10 +107,8 @@ Test-Suite TestClosure
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Closure
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -128,10 +121,8 @@ Test-Suite TestStats
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Stats
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -144,10 +135,8 @@ Test-Suite TestMxInMemory
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Mx
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -160,10 +149,8 @@ Test-Suite TestTracingInMemory
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Tracing
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -176,10 +163,8 @@ Test-Suite TestMxInTCP
   CPP-Options:       -DTEST_SUITE_MODULE=Control.Distributed.Process.Tests.Mx
   Build-Depends:     base >= 4.14 && < 5,
                      distributed-process-tests,
-                     network >= 2.3 && < 3.3,
-                     network-transport >= 0.4.1.0 && < 0.6,
                      network-transport-inmemory >= 0.5,
-                     test-framework >= 0.6 && < 0.9
+                     tasty >= 1.5 && <1.6,
   default-extensions: CPP
   default-language:  Haskell98
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs
@@ -42,9 +42,8 @@ import Control.Distributed.Process.Node
 import Control.Distributed.Process.Tests.Internal.Utils (pause)
 import Control.Distributed.Process.Serializable (Serializable)
 import Data.Maybe (isNothing, isJust)
-import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase)
 
 newtype Ping = Ping ProcessId
   deriving (Typeable, Binary, Show)
@@ -1770,8 +1769,8 @@ testCallLocal TestTransport{..} = do
   takeMVar result4 >>= assertBool "Expected 'True'"
   -- XXX: Testing that when mask_ $ callLocal p runs p in masked state.
 
-tests :: TestTransport -> IO [Test]
-tests testtrans = return [
+tests :: TestTransport -> IO TestTree
+tests testtrans = return $ testGroup "CH" [
      testGroup "Basic features" [
         testCase "Ping"                (testPing                testtrans)
       , testCase "Math"                (testMath                testtrans)

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Closure.hs
@@ -31,9 +31,8 @@ import Control.Distributed.Process.Internal.Types
 import Control.Distributed.Static (staticLabel, staticClosure)
 import qualified Network.Transport as NT
 
-import Test.HUnit (Assertion)
-import Test.Framework (Test)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, testCase)
 
 --------------------------------------------------------------------------------
 -- Supporting definitions                                                     --
@@ -563,10 +562,10 @@ testSpawnTerminate TestTransport{..} rtable = do
 
   takeMVar masterDone
 
-tests :: TestTransport -> IO [Test]
+tests :: TestTransport -> IO TestTree
 tests testtrans = do
     let rtable = __remoteTable . __remoteTableDecl $ initRemoteTable
-    return
+    return $ testGroup "Closure"
         [ testCase "Unclosure"       (testUnclosure       testtrans rtable)
         , testCase "Bind"            (testBind            testtrans rtable)
         , testCase "SendPureClosure" (testSendPureClosure testtrans rtable)

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Internal/Utils.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Internal/Utils.hs
@@ -79,8 +79,7 @@ import Control.Monad.STM (atomically)
 import Data.Binary
 import Data.Typeable (Typeable)
 
-import Test.HUnit (Assertion, assertFailure)
-import Test.HUnit.Base (assertBool)
+import Test.Tasty.HUnit (Assertion, assertBool)
 
 import GHC.Generics
 import System.Timeout (timeout)

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs
@@ -41,12 +41,8 @@ import Data.Maybe (isJust, fromJust, isNothing, fromMaybe, catMaybes)
 import Data.Typeable
 import GHC.Generics hiding (from)
 
-import Test.Framework
-  ( Test
-  , testGroup
-  )
-import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (assertBool, assertEqual)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (assertBool, assertEqual, testCase)
 
 data Publish = Publish
   deriving (Typeable, Generic, Eq)
@@ -461,11 +457,11 @@ testMxSend mNode label test = do
       send p' s
       return r
 
-tests :: TestTransport -> IO [Test]
+tests :: TestTransport -> IO TestTree
 tests TestTransport{..} = do
   node1 <- newLocalNode testTransport initRemoteTable
   node2 <- newLocalNode testTransport initRemoteTable
-  return [
+  return $ testGroup "Mx" [
       testGroup "MxAgents" [
           testCase "EventHandling"
               (delayedAssertion
@@ -527,7 +523,7 @@ tests TestTransport{..} = do
     build :: LocalNode
           -> LocalNode
           -> [(String, [(String, (Maybe LocalNode -> Process ()))])]
-          -> [Test]
+          -> [TestTree]
     build n ln specs =
       [ testGroup (intercalate "-" [groupName, caseSuffix]) [
              testCase (intercalate "-" [caseName, caseSuffix])

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Receive.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Receive.hs
@@ -14,9 +14,8 @@ import Control.Distributed.Process.Node
 
 import Control.Monad
 
-import Test.HUnit (Assertion, (@?=))
-import Test.Framework (Test)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, (@?=), testCase)
 
 -- Tests:
 
@@ -147,8 +146,8 @@ testReceive transport rtable = do
   node <- newLocalNode transport rtable
   runProcess node $ master
 
-tests :: TestTransport -> IO [Test]
+tests :: TestTransport -> IO TestTree
 tests TestTransport{..} = do
     let rtable = initRemoteTable
-    return
+    return $ testGroup "Receive"
         [ testCase "testReceive" (testReceive testTransport rtable) ]
diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Stats.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Stats.hs
@@ -16,12 +16,8 @@ import Control.Distributed.Process.Node
 import Data.Binary ()
 import Data.Typeable ()
 
-import Test.Framework
-  ( Test
-  , testGroup
-  )
-import Test.HUnit (Assertion)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, testCase)
 
 testLocalDeadProcessInfo :: TestResult (Maybe ProcessInfo) -> Process ()
 testLocalDeadProcessInfo result = do
@@ -107,10 +103,10 @@ testRemoteLiveProcessInfo TestTransport{..} node1 = do
       a <- delayedAssertion "getProcessInfo remotePid failed" n True
       return a
 
-tests :: TestTransport -> IO [Test]
+tests :: TestTransport -> IO TestTree
 tests testtrans@TestTransport{..} = do
   node1 <- newLocalNode testTransport initRemoteTable
-  return [
+  return $ testGroup "Stats" [
     testGroup "Process Info" [
         testCase "testLocalDeadProcessInfo"
             (delayedAssertion

diff --git a/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Tracing.hs b/packages/distributed-process-tests/src/Control/Distributed/Process/Tests/Tracing.hs
@@ -25,11 +25,8 @@ import Data.List (isPrefixOf, isSuffixOf)
 
 import Prelude hiding ((<*))
 
-import Test.Framework
-  ( Test
-  , testGroup
-  )
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ( testCase)
 import System.Environment (getEnvironment)
 -- These are available in System.Environment only since base 4.7
 import System.SetEnv (setEnv, unsetEnv)
@@ -375,14 +372,14 @@ testSystemLoggerMxUnRegistered t = testSystemLoggerMsg t
     (getSelfPid >>= register "a" >> unregister "a" >> getSelfPid)
     (\self -> isPrefixOf $ "MxUnRegistered " ++ show self ++ " " ++ show "a")
 
-tests :: TestTransport -> IO [Test]
+tests :: TestTransport -> IO TestTree
 tests testtrans@TestTransport{..} = do
   node1 <- newLocalNode testTransport initRemoteTable
   -- if we execute the test cases in parallel, the
   -- various tracers will race with one another and
   -- we'll get garbage results (or worse, deadlocks)
   lock <- liftIO $ newMVar ()
-  return [
+  return $ testGroup "Tracing" [
     testGroup "Tracing" [
            testCase "Spawn Tracing"
              (synchronisedAssertion

diff --git a/packages/distributed-process-tests/tests/runInMemory.hs b/packages/distributed-process-tests/tests/runInMemory.hs
@@ -6,9 +6,8 @@ import TEST_SUITE_MODULE (tests)
 
 import Network.Transport.Test (TestTransport(..))
 import Network.Transport.InMemory
-import Test.Framework (defaultMainWithArgs)
-
-import System.Environment (getArgs)
+import Test.Tasty (defaultMain, localOption)
+import Test.Tasty.Runners (NumThreads)
 
 main :: IO ()
 main = do
@@ -17,7 +16,6 @@ main = do
       { testTransport = transport
       , testBreakConnection = \addr1 addr2 -> breakConnection internals addr1 addr2 "user error"
       }
-    args <- getArgs
     -- Tests are time sensitive. Running the tests concurrently can slow them
     -- down enough that threads using threadDelay would wake up later than
     -- expected, thus changing the order in which messages were expected.
@@ -27,4 +25,4 @@ main = do
     -- The problem was first detected with
     -- 'Control.Distributed.Process.Tests.CH.testMergeChannels'
     -- in particular.
-    defaultMainWithArgs ts ("-j" : "1" : args)
+    defaultMain (localOption (1::NumThreads) ts)
diff --git a/packages/distributed-process-tests/tests/runTCP.hs b/packages/distributed-process-tests/tests/runTCP.hs
@@ -13,11 +13,11 @@ import Network.Transport.TCP
   , defaultTCPAddr
   , TCPParameters(..)
   )
-import Test.Framework (defaultMainWithArgs)
+import Test.Tasty (defaultMain, localOption)
+import Test.Tasty.Runners (NumThreads)
 
 import Control.Concurrent (threadDelay)
 import Control.Exception  (IOException, try)
-import System.Environment (getArgs)
 import System.IO
 
 main :: IO ()
@@ -34,7 +34,6 @@ main = do
           either (\e -> const (return ()) (e :: IOException)) close esock
           threadDelay 10000
       }
-    args <- getArgs
     -- Tests are time sensitive. Running the tests concurrently can slow them
     -- down enough that threads using threadDelay would wake up later than
     -- expected, thus changing the order in which messages were expected.
@@ -44,4 +43,4 @@ main = do
     -- The problem was first detected with
     -- 'Control.Distributed.Process.Tests.CH.testMergeChannels'
     -- in particular.
-    defaultMainWithArgs ts ("-j" : "1" : args)
+    defaultMain (localOption (1::NumThreads) ts)