Enable tests for ghc 9 and promote ghcVersion check

.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'

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

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,

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

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