Skip to content

Commit

Permalink
Enable tests for ghc 9 and promote ghcVersion check (#2001)
Browse files Browse the repository at this point in the history 
* Test 9.0.1 for windows and macOS

* Refactorize ghc checking in tests

* Replace CPP checks with ghcVersion

* Use GHC cpp and remove 8.4

* Use the ghc version runtime checker

* HLINT ann ignored for ghc-9 too

* Mark test as broken for win and ghc-9

* Use GHC90 in eval tests

* Disable tests for macos and ghc-9.0.1

* Test 9.0.1 for windows and macOS

* Refactorize ghc checking in tests

* Correct imports/exports

* Replace CPP checks with ghcVersion

* Use GHC cpp and remove 8.4

* Use the ghc version runtime checker

* HLINT ann ignored for ghc-9 too

* Mark test as broken for win and ghc-9

* Use GHC90 in eval tests

* Avoid reformatting code

* Remove not supported ghc-8.4

* Disable tests for macos and ghc-9.0.1

* Ignore hlint+cpp tests for win and ghc-9.0.
  • Loading branch information
@jneira
jneira authored Jul 7, 2021
1 parent 5471382 commit 8edb0f7
Show file tree
Hide file tree
Showing 8 changed files with 135 additions and 149 deletions.
11 changes: 7 additions & 4 deletions .github/workflows/test.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down
12 changes: 5 additions & 7 deletions ghcide/session-loader/Development/IDE/Session.hs
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}

{-|
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions ghcide/src/Development/IDE.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
33 changes: 27 additions & 6 deletions ghcide/src/Development/IDE/GHC/Compat.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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
172 changes: 79 additions & 93 deletions ghcide/test/exe/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand All @@ -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"
Expand All @@ -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
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 $
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Loading

0 comments on commit 8edb0f7

Please sign in to comment.