Mark distributed-process-supervisor test as flaky and retry on failure

Author: LaurentRDC

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

@@ -81,6 +81,7 @@ test-suite SupervisorTests
                    deepseq,
                    stm,
                    tasty >= 1.5 && <1.6,
+                   tasty-flaky >= 0.1.2 && <0.2,
                    tasty-hunit >=0.10 && <0.11,
                    exceptions >= 0.10 && < 0.11
   hs-source-dirs:  tests
@@ -109,6 +110,7 @@ test-suite NonThreadedSupervisorTests
                    stm,
                    tasty >= 1.5 && <1.6,
                    tasty-hunit >=0.10 && <0.11,
+                   tasty-flaky >= 0.1.2 && <0.2,
                    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

@@ -8,6 +8,9 @@
 -- NOTICE: Some of these tests are /unsafe/, and will fail intermittently, since
 -- they rely on ordering constraints which the Cloud Haskell runtime does not
 -- guarantee.
+--
+-- Such tests can be marked as 'flaky' using 'tasty-flaky', so they get
+-- retried on failure.
 
 module Main where
 
@@ -52,13 +55,17 @@ import Data.ByteString.Lazy (empty)
 import Data.Maybe (catMaybes, isNothing, isJust)
 
 import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Flaky (flakyTest, limitRetries)
 import Test.Tasty.HUnit (Assertion, assertFailure, assertEqual, assertBool, testCase)
 import TestUtils hiding (waitForExit)
 import qualified Network.Transport as NT
 
 import System.Random (mkStdGen, randomR)
 -- test utilities
 
+flaky :: TestTree -> TestTree
+flaky = flakyTest (limitRetries 3)
+
 expectedExitReason :: ProcessId -> String
 expectedExitReason sup = "killed-by=" ++ (show sup) ++
                          ",reason=StoppedBySupervisor"
@@ -1304,10 +1311,11 @@ tests transport = do
                 (withSupervisor restartOne []
                     (withClosure transientChildrenAbnormalExit
                                  $(mkStaticClosure 'blockIndefinitely)))
-          , testCase "ExitShutdown Is Considered Normal"
-                (withSupervisor' restartOne []
-                    (withClosure' transientChildrenExitShutdown
-                                 $(mkStaticClosure 'blockIndefinitely)))
+          , flaky $
+              testCase "ExitShutdown Is Considered Normal"
+                  (withSupervisor' restartOne []
+                      (withClosure' transientChildrenExitShutdown
+                                   $(mkStaticClosure 'blockIndefinitely)))
           , testCase "Intrinsic Children Do Restart When Exiting Abnormally (Closure)"
                 (withSupervisor restartOne []
                     (withClosure intrinsicChildrenAbnormalExit