diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 34526ab0d5..f6fcd46490 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -49,19 +49,22 @@ jobs: - os: ubuntu-latest ghc: '8.6.5' test: true - # only build rest of supported ghc versions for windows + - os: windows-latest + ghc: '9.0.1' + test: true - os: windows-latest ghc: '8.10.5' test: true + - os: windows-latest + ghc: '8.6.5' + test: true + # only build rest of supported ghc versions for windows - os: windows-latest ghc: '8.10.4' - os: windows-latest ghc: '8.10.3' - os: windows-latest ghc: '8.10.2.2' - - os: windows-latest - ghc: '8.6.5' - test: true # This build get stuck frequently # - os: windows-latest # ghc: '8.6.4' diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 460dbf7d0d..7a88249823 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-| @@ -197,7 +196,7 @@ runWithDb fp k = do getHieDbLoc :: FilePath -> IO FilePath getHieDbLoc dir = do - let db = intercalate "-" [dirHash, takeBaseName dir, VERSION_ghc, hiedbDataVersion] <.> "hiedb" + let db = intercalate "-" [dirHash, takeBaseName dir, ghcVersionStr, hiedbDataVersion] <.> "hiedb" dirHash = B.unpack $ B16.encode $ H.hash $ B.pack dir cDir <- IO.getXdgDirectory IO.XdgCache cacheDir createDirectoryIfMissing True cDir @@ -526,11 +525,10 @@ cradleToOptsAndLibDir cradle file = do emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv emptyHscEnv nc libDir = do env <- runGhc (Just libDir) getSession -#if !MIN_VERSION_ghc(9,0,0) - -- This causes ghc9 to crash with the error: - -- Couldn't find a target code interpreter. Try with -fexternal-interpreter - initDynLinker env -#endif + when (ghcVersion < GHC90) $ + -- This causes ghc9 to crash with the error: + -- Couldn't find a target code interpreter. Try with -fexternal-interpreter + initDynLinker env pure $ setNameCache nc env{ hsc_dflags = (hsc_dflags env){useUnicode = True } } data TargetDetails = TargetDetails diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index ec1373f5e0..f76577da13 100644 --- a/ghcide/src/Development/IDE.hs +++ b/ghcide/src/Development/IDE.hs @@ -42,6 +42,8 @@ import Development.IDE.Core.Shake as X (FastResult (..), useWithStaleFast', useWithStale_, use_, uses, uses_) +import Development.IDE.GHC.Compat as X (GhcVersion (..), + ghcVersion) import Development.IDE.GHC.Error as X import Development.IDE.GHC.Util as X import Development.IDE.Graph as X (Action, RuleResult, diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 31071421e3..98391f6364 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -127,8 +127,12 @@ module Development.IDE.GHC.Compat( applyPluginsParsedResultAction, module Compat.HieTypes, module Compat.HieUtils, - dropForAll - ,isQualifiedImport) where + dropForAll, + isQualifiedImport, + GhcVersion(..), + ghcVersion, + ghcVersionStr + ) where #if MIN_VERSION_ghc(8,10,0) import LinkerTypes @@ -524,7 +528,7 @@ dropForAll = snd . GHC.splitLHsForAllTy #endif pattern FunTy :: Type -> Type -> Type -#if MIN_VERSION_ghc(8, 10, 0) +#if MIN_VERSION_ghc(8,10,0) pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res} #else pattern FunTy arg res <- TyCoRep.FunTy arg res @@ -541,7 +545,7 @@ isQualifiedImport _ = False -#if __GLASGOW_HASKELL__ >= 900 +#if MIN_VERSION_ghc(9,0,0) getNodeIds :: HieAST a -> M.Map Identifier (IdentifierDetails a) getNodeIds = M.foldl' combineNodeIds M.empty . getSourcedNodeInfo . sourcedNodeInfo @@ -586,6 +590,23 @@ stringToUnit = Module.stringToUnitId rtsUnit = Module.rtsUnitId #endif -#if MIN_VERSION_ghc(9,0,0) -#else +data GhcVersion + = GHC86 + | GHC88 + | GHC810 + | GHC90 + deriving (Eq, Ord, Show) + +ghcVersionStr :: String +ghcVersionStr = VERSION_ghc + +ghcVersion :: GhcVersion +#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) +ghcVersion = GHC90 +#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) +ghcVersion = GHC810 +#elif MIN_VERSION_GLASGOW_HASKELL(8,8,0,0) +ghcVersion = GHC88 +#elif MIN_VERSION_GLASGOW_HASKELL(8,6,0,0) +ghcVersion = GHC86 #endif diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 9f67fcdcb7..40f3ddab5f 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -35,6 +35,8 @@ import Development.IDE.Core.PositionMapping (PositionResult (..), positionResultToMaybe, toCurrent) import Development.IDE.Core.Shake (Q (..)) +import Development.IDE.GHC.Compat (GhcVersion (..), + ghcVersion) import Development.IDE.GHC.Util import qualified Development.IDE.Main as IDE import Development.IDE.Plugin.Completions.Types (extendImportCommandId) @@ -538,17 +540,15 @@ diagnosticTests = testGroup "diagnostics" , "foo = 1 {-|-}" ] _ <- createDoc "Foo.hs" "haskell" fooContent -#if MIN_VERSION_ghc(9,0,1) - -- Haddock parse errors are ignored on ghc-9.0.1 - pure () -#else - expectDiagnostics - [ ( "Foo.hs" - , [(DsWarning, (2, 8), "Haddock parse error on input") + if ghcVersion >= GHC90 then + -- Haddock parse errors are ignored on ghc-9.0.1 + pure () + else + expectDiagnostics + [ ( "Foo.hs" + , [(DsWarning, (2, 8), "Haddock parse error on input")] + ) ] - ) - ] -#endif , testSessionWait "strip file path" $ do let name = "Testing" @@ -3629,12 +3629,11 @@ findDefinitionAndHoverTests = let mkFindTests -- def hover look expect [ -#if MIN_VERSION_ghc(9,0,0) - -- It suggests either going to the constructor or to the field - test broken yes fffL4 fff "field in record definition" -#else - test yes yes fffL4 fff "field in record definition" -#endif + if ghcVersion >= GHC90 then + -- It suggests either going to the constructor or to the field + test broken yes fffL4 fff "field in record definition" + else + test yes yes fffL4 fff "field in record definition" , test yes yes fffL8 fff "field in record construction #1102" , test yes yes fffL14 fff "field name used as accessor" -- https://github.com/haskell/ghcide/pull/120 in Calculate.hs , test yes yes aaaL14 aaa "top-level name" -- https://github.com/haskell/ghcide/pull/120 @@ -3657,11 +3656,10 @@ findDefinitionAndHoverTests = let , test yes yes lclL33 lcb "listcomp lookup" , test yes yes mclL36 mcl "top-level fn 1st clause" , test yes yes mclL37 mcl "top-level fn 2nd clause #1030" -#if MIN_VERSION_ghc(8,10,0) - , test yes yes spaceL37 space "top-level fn on space #1002" -#else - , test yes broken spaceL37 space "top-level fn on space #1002" -#endif + , if ghcVersion >= GHC810 then + test yes yes spaceL37 space "top-level fn on space #1002" + else + test yes broken spaceL37 space "top-level fn on space #1002" , test no yes docL41 doc "documentation #1129" , test no yes eitL40 kindE "kind of Either #1017" , test no yes intL40 kindI "kind of Int #1017" @@ -3670,18 +3668,20 @@ findDefinitionAndHoverTests = let , test no broken chrL36 litC "literal Char in hover info #1016" , test no broken txtL8 litT "literal Text in hover info #1016" , test no broken lstL43 litL "literal List in hover info #1016" -#if MIN_VERSION_ghc(9,0,0) - , test no yes docL41 constr "type constraint in hover info #1012" -#else - , test no broken docL41 constr "type constraint in hover info #1012" -#endif + , if ghcVersion >= GHC90 then + test no yes docL41 constr "type constraint in hover info #1012" + else + test no broken docL41 constr "type constraint in hover info #1012" , test broken broken outL45 outSig "top-level signature #767" , test broken broken innL48 innSig "inner signature #767" , test no yes holeL60 hleInfo "hole without internal name #831" , test no skip cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" - , test no yes thLocL57 thLoc "TH Splice Hover" + , if ghcVersion == GHC90 && isWindows then + test no broken thLocL57 thLoc "TH Splice Hover" + else + test no yes thLocL57 thLoc "TH Splice Hover" ] where yes, broken :: (TestTree -> Maybe TestTree) yes = Just -- test should run and pass @@ -3699,7 +3699,7 @@ pluginSimpleTests :: TestTree pluginSimpleTests = ignoreInWindowsForGHC88And810 $ #if __GLASGOW_HASKELL__ == 810 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 5 - expectFailBecause "known broken (see GHC #19763)" $ + expectFailBecause "known broken for ghc 8.10.5 (see GHC #19763)" $ #endif testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" @@ -4404,34 +4404,26 @@ highlightTests = testGroup "highlight" , DocumentHighlight (R 6 10 6 13) (Just HkRead) , DocumentHighlight (R 7 12 7 15) (Just HkRead) ] - , -#if MIN_VERSION_ghc(9,0,0) - expectFailBecause "Ghc9 highlights the constructor and not just this field" $ -#endif - testSessionWait "record" $ do - doc <- createDoc "A.hs" "haskell" recsource - _ <- waitForDiagnostics - highlights <- getHighlights doc (Position 4 15) - liftIO $ highlights @?= List - -- Span is just the .. on 8.10, but Rec{..} before - [ -#if MIN_VERSION_ghc(8,10,0) - DocumentHighlight (R 4 8 4 10) (Just HkWrite) -#else - DocumentHighlight (R 4 4 4 11) (Just HkWrite) -#endif - , DocumentHighlight (R 4 14 4 20) (Just HkRead) - ] - highlights <- getHighlights doc (Position 3 17) - liftIO $ highlights @?= List - [ DocumentHighlight (R 3 17 3 23) (Just HkWrite) - -- Span is just the .. on 8.10, but Rec{..} before -#if MIN_VERSION_ghc(8,10,0) - , DocumentHighlight (R 4 8 4 10) (Just HkRead) -#else - , DocumentHighlight (R 4 4 4 11) (Just HkRead) -#endif - ] + , knownBrokenForGhcVersions [GHC90] "Ghc9 highlights the constructor and not just this field" $ + testSessionWait "record" $ do + doc <- createDoc "A.hs" "haskell" recsource + _ <- waitForDiagnostics + highlights <- getHighlights doc (Position 4 15) + liftIO $ highlights @?= List + -- Span is just the .. on 8.10, but Rec{..} before + [ if ghcVersion >= GHC810 + then DocumentHighlight (R 4 8 4 10) (Just HkWrite) + else DocumentHighlight (R 4 4 4 11) (Just HkWrite) + , DocumentHighlight (R 4 14 4 20) (Just HkRead) + ] + highlights <- getHighlights doc (Position 3 17) + liftIO $ highlights @?= List + [ DocumentHighlight (R 3 17 3 23) (Just HkWrite) + -- Span is just the .. on 8.10, but Rec{..} before + , if ghcVersion >= GHC810 + then DocumentHighlight (R 4 8 4 10) (Just HkRead) + else DocumentHighlight (R 4 4 4 11) (Just HkRead) + ] ] where source = T.unlines @@ -4636,23 +4628,27 @@ xfail :: TestTree -> String -> TestTree xfail = flip expectFailBecause ignoreInWindowsBecause :: String -> TestTree -> TestTree -ignoreInWindowsBecause = if isWindows then ignoreTestBecause else (\_ x -> x) +ignoreInWindowsBecause + | isWindows = ignoreTestBecause + | otherwise = \_ x -> x ignoreInWindowsForGHC88And810 :: TestTree -> TestTree -#if MIN_VERSION_ghc(8,8,1) && !MIN_VERSION_ghc(9,0,0) -ignoreInWindowsForGHC88And810 = - ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8 and 8.10" -#else -ignoreInWindowsForGHC88And810 = id -#endif +ignoreInWindowsForGHC88And810 + | ghcVersion `elem` [GHC88, GHC810] = + ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8 and 8.10" + | otherwise = id ignoreInWindowsForGHC88 :: TestTree -> TestTree -#if MIN_VERSION_ghc(8,8,1) && !MIN_VERSION_ghc(8,10,1) -ignoreInWindowsForGHC88 = - ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8" -#else -ignoreInWindowsForGHC88 = id -#endif +ignoreInWindowsForGHC88 + | ghcVersion == GHC88 = + ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8" + | otherwise = id + +knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree +knownBrokenForGhcVersions ghcVers + | ghcVersion `elem` ghcVers = expectFailBecause + | otherwise = \_ x -> x + data Expect = ExpectRange Range -- Both gotoDef and hover should report this range @@ -4811,13 +4807,11 @@ dependentFileTest = testGroup "addDependentFile" let bazContent = T.unlines ["module Baz where", "import Foo ()"] _ <- createDoc "Foo.hs" "haskell" fooContent doc <- createDoc "Baz.hs" "haskell" bazContent - expectDiagnostics -#if MIN_VERSION_ghc(9,0,0) - -- String vs [Char] causes this change in error message - [("Foo.hs", [(DsError, (4, 6), "Couldn't match type")])] -#else - [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])] -#endif + expectDiagnostics $ + if ghcVersion >= GHC90 + -- String vs [Char] causes this change in error message + then [("Foo.hs", [(DsError, (4, 6), "Couldn't match type")])] + else [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])] -- Now modify the dependent file liftIO $ writeFile depFilePath "B" sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $ @@ -5083,13 +5077,11 @@ sessionDepsArePickedUp = testSession' "cradle: {direct: {arguments: []}}" -- Open without OverloadedStrings and expect an error. doc <- createDoc "Foo.hs" "haskell" fooContent - expectDiagnostics -#if MIN_VERSION_ghc(9,0,0) - -- String vs [Char] causes this change in error message - [("Foo.hs", [(DsError, (3, 6), "Couldn't match type")])] -#else - [("Foo.hs", [(DsError, (3, 6), "Couldn't match expected type")])] -#endif + expectDiagnostics $ + if ghcVersion >= GHC90 + -- String vs [Char] causes this change in error message + then [("Foo.hs", [(DsError, (3, 6), "Couldn't match type")])] + else [("Foo.hs", [(DsError, (3, 6), "Couldn't match expected type")])] -- Update hie.yaml to enable OverloadedStrings. liftIO $ writeFileUTF8 @@ -5799,16 +5791,10 @@ assertJust s = \case -- | Before ghc9, lists of Char is displayed as [Char], but with ghc9 and up, it's displayed as String listOfChar :: T.Text -#if MIN_VERSION_ghc(9,0,1) -listOfChar = "String" -#else -listOfChar = "[Char]" -#endif +listOfChar | ghcVersion >= GHC90 = "String" + | otherwise = "[Char]" -- | Ghc 9 doesn't include the $-sign in TH warnings like earlier versions did thDollarIdx :: Int -#if MIN_VERSION_ghc(9,0,1) -thDollarIdx = 1 -#else -thDollarIdx = 0 -#endif +thDollarIdx | ghcVersion >= GHC90 = 1 + | otherwise = 0 diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index e54f018e33..b2785cf7bc 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -51,6 +51,7 @@ import Data.List.Extra (find) import Data.Maybe import qualified Data.Set as Set import qualified Data.Text as T +import Development.IDE (GhcVersion(..), ghcVersion) import qualified Language.LSP.Test as Test import Language.LSP.Types hiding (Reason (..)) import qualified Language.LSP.Types.Capabilities as C @@ -107,27 +108,6 @@ files = -- , "./test/testdata/wErrorTest/" ] -data GhcVersion - = GHC810 - | GHC88 - | GHC86 - | GHC84 - | GHC901 - deriving (Eq,Show) - -ghcVersion :: GhcVersion -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,0,1,0))) -ghcVersion = GHC901 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,0,0))) -ghcVersion = GHC810 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0))) -ghcVersion = GHC88 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0))) -ghcVersion = GHC86 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -ghcVersion = GHC84 -#endif - data EnvSpec = HostOS OS | GhcVer GhcVersion deriving (Show, Eq) @@ -151,25 +131,19 @@ knownBrokenInEnv envSpecs reason | otherwise = id knownBrokenOnWindows :: String -> TestTree -> TestTree -knownBrokenOnWindows reason - | isWindows = expectFailBecause reason - | otherwise = id +knownBrokenOnWindows = knownBrokenInEnv [HostOS Windows] knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree -knownBrokenForGhcVersions vers reason - | ghcVersion `elem` vers = expectFailBecause reason - | otherwise = id +knownBrokenForGhcVersions vers = knownBrokenInEnv (map GhcVer vers) --- | IgnroeTest if /any/ of environmental spec mathces the current environment. +-- | IgnoreTest if /any/ of environmental spec mathces the current environment. ignoreInEnv :: [EnvSpec] -> String -> TestTree -> TestTree ignoreInEnv envSpecs reason | any matchesCurrentEnv envSpecs = ignoreTestBecause reason | otherwise = id ignoreForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree -ignoreForGhcVersions vers reason - | ghcVersion `elem` vers = ignoreTestBecause reason - | otherwise = id +ignoreForGhcVersions vers = ignoreInEnv (map GhcVer vers) -- --------------------------------------------------------------------- diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 38fbf660a6..f1faceeb16 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -65,7 +65,7 @@ tests = , testCase "Semantic and Lexical errors are reported" $ do evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName" evalInFile "T8.hs" "-- >>> \"a\" + \"bc\"" $ - if ghcVersion == GHC901 + if ghcVersion == GHC90 then "-- No instance for (Num String) arising from a use of ‘+’" else "-- No instance for (Num [Char]) arising from a use of ‘+’" evalInFile "T8.hs" "-- >>> \"" "-- lexical error in string/character literal at end of input" @@ -86,7 +86,7 @@ tests = , testCase ":type handles a multilined result properly" $ evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [ "-- fun", - if ghcVersion == GHC901 + if ghcVersion == GHC90 then "-- :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}." else "-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).", "-- (KnownNat k2, KnownNat n, Typeable a) =>", @@ -95,7 +95,7 @@ tests = , goldenWithEval ":t behaves exactly the same as :type" "T22" "hs" , testCase ":type does \"dovetails\" for short identifiers" $ evalInFile "T23.hs" "-- >>> :type f" $ T.unlines [ - if ghcVersion == GHC901 + if ghcVersion == GHC90 then "-- f :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}." else "-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).", "-- (KnownNat k2, KnownNat n, Typeable a) =>", @@ -126,10 +126,10 @@ tests = , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs" , goldenWithEval "Test on last line insert results correctly" "TLastLine" "hs" , testGroup "with preprocessors" - [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86] + [ knownBrokenInEnv [HostOS Windows, GhcVer GHC86] "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $ goldenWithEval "CPP support" "TCPP" "hs" - , knownBrokenForGhcVersions [GHC84, GHC86] + , knownBrokenForGhcVersions [GHC86] "Preprocessor known to fail on GHC <= 8.6" $ goldenWithEval "Literate Haskell Bird Style" "TLHS" "lhs" -- , goldenWithEval "Literate Haskell LaTeX Style" "TLHSLateX" "lhs" diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 877987505c..97881fff6e 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -133,12 +133,14 @@ hlintTests = testGroup "hlint suggestions" [ testRefactor "ApplyRefact1.hs" "Redundant bracket" ("{-# LANGUAGE LambdaCase #-}" : expectedLambdaCase) - , expectFailBecause "apply-refact doesn't work with cpp" $ + , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Test make execution does not terminate for windows and ghc-9.0" $ + expectFailBecause "apply-refact doesn't work with cpp" $ testCase "apply hints works with CPP via -XCPP argument" $ runHlintSession "cpp" $ do testRefactor "ApplyRefact3.hs" "Redundant bracket" expectedCPP - , expectFailBecause "apply-refact doesn't work with cpp" $ + , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Test make execution does not terminate for windows and ghc-9.0" $ + expectFailBecause "apply-refact doesn't work with cpp" $ testCase "apply hints works with CPP via language pragma" $ runHlintSession "" $ do testRefactor "ApplyRefact3.hs" "Redundant bracket" ("{-# LANGUAGE CPP #-}" : expectedCPP) @@ -151,7 +153,7 @@ hlintTests = testGroup "hlint suggestions" [ doc <- openDoc "ApplyRefact4.hs" "haskell" expectNoMoreDiagnostics 3 doc "hlint" - , knownBrokenForGhcVersions [GHC810, GHC901] "hlint plugin doesn't honour HLINT annotations (#838)" $ + , knownBrokenForGhcVersions [GHC810, GHC90] "hlint plugin doesn't honour HLINT annotations (#838)" $ testCase "hlint diagnostics ignore hints honouring HLINT annotations" $ runHlintSession "" $ do doc <- openDoc "ApplyRefact5.hs" "haskell" expectNoMoreDiagnostics 3 doc "hlint"