Ported distributed-process-supervisor

Author: LaurentRDC

packages/distributed-process-supervisor/distributed-process-supervisor.cabal

@@ -78,10 +78,9 @@ test-suite SupervisorTests
                    network-transport-tcp >= 0.4 && < 0.9,
                    binary >= 0.8 && < 0.9,
                    deepseq,
-                   HUnit >= 1.2 && < 2,
                    stm,
-                   test-framework >= 0.6 && < 0.9,
-                   test-framework-hunit,
+                   tasty >= 1.5 && <1.6,
+                   tasty-hunit >=0.10 && <0.11,
                    exceptions >= 0.10 && < 0.11
   hs-source-dirs:  tests
   ghc-options:     -threaded -rtsopts -with-rtsopts=-N -fno-warn-name-shadowing -fno-warn-unused-do-bind
@@ -106,10 +105,9 @@ test-suite NonThreadedSupervisorTests
                    network-transport-tcp >= 0.4 && < 0.9,
                    binary >= 0.8 && < 0.9,
                    deepseq,
-                   HUnit >= 1.2 && < 2,
                    stm,
-                   test-framework >= 0.6 && < 0.9,
-                   test-framework-hunit,
+                   tasty >= 1.5 && <1.6,
+                   tasty-hunit >=0.10 && <0.11,
                    exceptions >= 0.10 && < 0.11
   hs-source-dirs:  tests
   ghc-options:     -rtsopts -fno-warn-unused-do-bind -fno-warn-name-shadowing

packages/distributed-process-supervisor/tests/TestSupervisor.hs

@@ -51,9 +51,8 @@ import Control.Monad.Catch (finally)
 import Data.ByteString.Lazy (empty)
 import Data.Maybe (catMaybes, isNothing, isJust)
 
-import Test.HUnit (Assertion, assertFailure, assertEqual, assertBool)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, assertFailure, assertEqual, assertBool, testCase)
 import TestUtils hiding (waitForExit)
 import qualified Network.Transport as NT
 
@@ -1198,7 +1197,7 @@ withClosure' fn clj ctx = do
   cs <- toChildStart clj
   fn cs ctx
 
-tests :: NT.Transport -> IO [Test]
+tests :: NT.Transport -> IO TestTree
 tests transport = do
   putStrLn $ concat [ "NOTICE: Branch Tests (Relying on Non-Guaranteed Message Order) "
                     , "Can Fail Intermittently" ]
@@ -1215,8 +1214,8 @@ tests transport = do
   let withSup' sm = runInTestContext' localNode sm
   let withSupervisor = runInTestContext localNode singleTestLock ParallelShutdown
   let withSupervisor' = runInTestContext' localNode ParallelShutdown
-  return
-    [ testGroup "Supervisor Processes"
+  return $
+    testGroup "Supervisor Processes"
       [
           testGroup "Starting And Adding Children"
           [
@@ -1449,14 +1448,6 @@ tests transport = do
                 (delayedRestartAfterThreeAttempts withSupervisor')
           ]
       ]
-{-    , testGroup "CI"
-      [ testCase "Flush [NonTest]"
-        (withSupervisor'
-          (RestartRight defaultLimits (RestartInOrder LeftToRight)) []
-           (\_ -> sleep $ seconds 20))
-      ]
--}
-    ]
 
 main :: IO ()
 main = testMain $ tests

packages/distributed-process-supervisor/tests/TestUtils.hs

@@ -60,9 +60,8 @@ import qualified Control.Exception as Exception
 import Control.Monad (forever)
 import Control.Monad.Catch (catch)
 import Control.Monad.STM (atomically)
-import Test.HUnit (Assertion, assertEqual)
-import Test.HUnit.Base (assertBool)
-import Test.Framework (Test, defaultMain)
+import Test.Tasty (TestTree, defaultMain)
+import Test.Tasty.HUnit (Assertion, assertEqual, assertBool)
 import Control.DeepSeq
 
 import Network.Transport.TCP
@@ -137,7 +136,7 @@ stopLogger :: Logger -> IO ()
 stopLogger = (flip Exception.throwTo) Exception.ThreadKilled . _tid
 
 -- | 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" "0") defaultTCPParameters
   testData <- builder transport