Introduce test-utils for marking tests as flaky

Author: fendor

ghcide/src/Development/IDE/GHC/Compat.hs

@@ -616,7 +616,7 @@ data GhcVersion
   | GHC92
   | GHC94
   | GHC96
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Enum, Bounded)
 
 ghcVersionStr :: String
 ghcVersionStr = VERSION_ghc

ghcide/test/exe/Main.hs

@@ -138,8 +138,7 @@ import           Development.IDE.Types.Logger             (Logger (Logger),
                                                            WithPriority (WithPriority, priority),
                                                            cfilter,
                                                            cmapWithPrio,
-                                                           makeDefaultStderrRecorder,
-                                                           toCologActionWithPrio)
+                                                           makeDefaultStderrRecorder)
 import qualified FuzzySearch
 import           GHC.Stack                                (emptyCallStack)
 import qualified HieDbRetry
@@ -151,12 +150,11 @@ import           Language.LSP.Types.Lens                  (didChangeWatchedFiles
 import qualified Language.LSP.Types.Lens                  as L
 import qualified Progress
 import           System.Time.Extra
-import qualified Test.QuickCheck.Monadic                  as MonadicQuickCheck
-import           Test.QuickCheck.Monadic                  (forAllM, monadicIO)
 import           Test.Tasty
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
+import           Test.Tasty.Runners as Runners
 import           Test.Tasty.QuickCheck
 import           Text.Printf                              (printf)
 import           Text.Regex.TDFA                          ((=~))
@@ -2084,7 +2082,6 @@ completionDocTests =
       test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
   ]
   where
-    brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94, GHC96]) "Completion doc doesn't support ghc9"
     brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2"
     -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903
     brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9"
@@ -2373,7 +2370,7 @@ knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers)
 
 data BrokenOS = Linux | MacOS | Windows deriving (Show)
 
-data IssueSolution = Broken | Ignore deriving (Show)
+data IssueSolution = Broken | Ignore | Flaky deriving (Show)
 
 data BrokenTarget =
     BrokenSpecific BrokenOS [GhcVersion]
@@ -2392,6 +2389,14 @@ ignoreFor = knownIssueFor Ignore
 knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree
 knownBrokenFor = knownIssueFor Broken
 
+-- | Mark test as flaky for a specific target
+knownFlakyFor :: BrokenTarget -> String -> TestTree -> TestTree
+knownFlakyFor = knownIssueFor Flaky
+
+-- | Mark test as flaky for all GHC versions
+knownFlaky :: String -> TestTree -> TestTree
+knownFlaky = knownIssueFor Flaky (BrokenForGHC [minBound .. maxBound])
+
 -- | Deal with `IssueSolution` for specific OS and GHC.
 knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree
 knownIssueFor solution = go . \case
@@ -2409,8 +2414,30 @@ knownIssueFor solution = go . \case
         go True = case solution of
             Broken -> expectFailBecause
             Ignore -> ignoreTestBecause
+            Flaky -> knownFlakyBecause
         go False = \_ -> id
 
+-- | The test can no longer fail and is marked as flaky.
+-- Flaky tests are tests that sometimes fail but sometimes also succeed.
+-- Ideally, such test cases should not exist at all, but at least in this codebase,
+-- the reality is, that we do have a number of flaky test cases.
+--
+-- The code is basically copy-pasted from 'tasty-expected-failure' and if this
+-- function proves useful in practice, we will upstream it.
+knownFlakyBecause :: String -> TestTree -> TestTree
+knownFlakyBecause info = wrapTest (fmap change)
+  where
+    change r
+      | resultSuccessful r
+      = r { resultDescription = resultDescription r <> " (flaky testcase: " <> info <> ")"
+          , resultShortDescription = resultShortDescription r <> " (flaky testcase)"
+          }
+      | otherwise
+      = r { resultOutcome = Runners.Success
+          , resultDescription = resultDescription r <> " (failed flaky testcase failed: " <> info <> ")"
+          , resultShortDescription = resultShortDescription r <> " (failed flaky testcase)"
+          }
+
 data Expect
   = ExpectRange Range -- Both gotoDef and hover should report this range
   | ExpectLocation Location