diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 0f9069b006..8f28d8ca72 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/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 diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index c690c0b9bd..7d7de401ba 100644 --- a/ghcide/test/exe/Main.hs +++ b/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 ((=~)) @@ -2369,7 +2367,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] @@ -2388,6 +2386,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 @@ -2405,8 +2411,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 @@ -2867,9 +2895,9 @@ ifaceErrorTest3 = testCase "iface-error-test-3" $ runWithExtraFiles "recomp" $ \ expectNoMoreDiagnostics 2 sessionDepsArePickedUp :: TestTree -sessionDepsArePickedUp = testSession' - "session-deps-are-picked-up" - $ \dir -> do +sessionDepsArePickedUp = knownFlaky + "Regularly timeouts, likely due to a race in reloading session changes when hie.yaml changes." + $ testSession' "session-deps-are-picked-up" $ \dir -> do liftIO $ writeFileUTF8 (dir "hie.yaml") diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index e654ee9660..2bc2756703 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -21,6 +21,8 @@ module Test.Hls.Util , knownBrokenForGhcVersions , knownBrokenInEnv , onlyWorkForGhcVersions + , knownFlakyInEnv + , knownFlaky -- * Extract code actions , fromAction , fromCommand @@ -71,9 +73,11 @@ import System.IO.Temp import System.Time.Extra (Seconds, sleep) import Test.Tasty (TestTree) import Test.Tasty.ExpectedFailure (expectFailBecause, - ignoreTestBecause) + ignoreTestBecause, wrapTest) import Test.Tasty.HUnit (Assertion, assertFailure, (@?=)) +import Test.Tasty.Runners (Result(..), resultSuccessful) +import qualified Test.Tasty.Runners as Runners noLiteralCaps :: C.ClientCapabilities noLiteralCaps = def & textDocument ?~ textDocumentCaps @@ -143,6 +147,57 @@ onlyRunForGhcVersions vers = then const id else ignoreTestBecause +-- | Mark test as flaky for a specific target. +-- This runs the test, but its result does not matter for the test suite. +-- +-- We define a test as flaky if it is fundamentally correct, but +-- fails occasionally due to lsp-test shenanigans. In particular, when the +-- test times out *sometimes*, but not always. +-- +-- A flaky test is a bug, which we are only not fixing right away +-- because it might be difficult to fix with lsp-test. +-- If your test isn't using lsp-test, then using this function +-- is not permitted. +knownFlakyInEnv :: [EnvSpec] -> String -> TestTree -> TestTree +knownFlakyInEnv envSpecs reason + | any matchesCurrentEnv envSpecs = knownFlakyBecause reason + | otherwise = id + +-- | Mark test as flaky for all supported GHC versions. +-- This runs the test, but its result does not matter for the test suite. +-- +-- We define a test as flaky if it is fundamentally correct, but +-- fails occasionally due to lsp-test shenanigans. In particular, when the +-- test times out *sometimes*, but not always. +-- +-- A flaky test is a bug, which we are only not fixing right away +-- because it might be difficult to fix with lsp-test. +-- If your test isn't using lsp-test, then using this function +-- is not permitted. +knownFlaky :: String -> TestTree -> TestTree +knownFlaky = knownFlakyInEnv (map GhcVer [minBound .. maxBound]) + +-- | 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)" + } + -- --------------------------------------------------------------------- -- | Like 'withCurrentDirectory', but will copy the directory over to the system