Skip to content

Commit

Permalink
Fix regression in GhcSessionDeps (#2380)
Browse files Browse the repository at this point in the history
* Fix regression in GhcSessionDeps

We cannot use GetModIfaceWithoutLinkable since the session might be reused later to load a module that needs linkables

Note that this does not have any effects on performance, since GetModIfaceWithoutLinkable is just a synonym for GetModIface that removes the linkable

Fixes #2379

* add test files

* delete unused bits

* Tweak test for compat. with GHC 9.0.1
  • Loading branch information
pepeiborra authored Nov 22, 2021
1 parent b7e3a64 commit abebf26
Show file tree
Hide file tree
Showing 9 changed files with 36 additions and 31 deletions.
9 changes: 0 additions & 9 deletions ghcide/src/Development/IDE/Core/RuleTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -252,10 +252,6 @@ type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
-- | Get a module interface details, either from an interface file or a typechecked module
type instance RuleResult GetModIface = HiFileResult

-- | Get a module interface details, without the Linkable
-- For better early cuttoff
type instance RuleResult GetModIfaceWithoutLinkable = HiFileResult

-- | Get the contents of a file, either dirty (if the buffer is modified) or Nothing to mean use from disk.
type instance RuleResult GetFileContents = (FileVersion, Maybe Text)

Expand Down Expand Up @@ -430,11 +426,6 @@ data GetModIface = GetModIface
instance Hashable GetModIface
instance NFData GetModIface

data GetModIfaceWithoutLinkable = GetModIfaceWithoutLinkable
deriving (Eq, Show, Typeable, Generic)
instance Hashable GetModIfaceWithoutLinkable
instance NFData GetModIfaceWithoutLinkable

data IsFileOfInterest = IsFileOfInterest
deriving (Eq, Show, Typeable, Generic)
instance Hashable IsFileOfInterest
Expand Down
24 changes: 4 additions & 20 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ module Development.IDE.Core.Rules(
loadGhcSession,
getModIfaceFromDiskRule,
getModIfaceRule,
getModIfaceWithoutLinkableRule,
getModSummaryRule,
isHiFileStableRule,
getModuleGraphRule,
Expand Down Expand Up @@ -688,13 +687,11 @@ loadGhcSession ghcSessionDepsConfig = do

data GhcSessionDepsConfig = GhcSessionDepsConfig
{ checkForImportCycles :: Bool
, forceLinkables :: Bool
, fullModSummary :: Bool
}
instance Default GhcSessionDepsConfig where
def = GhcSessionDepsConfig
{ checkForImportCycles = True
, forceLinkables = False
, fullModSummary = False
}

Expand All @@ -707,17 +704,12 @@ ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
Nothing -> return Nothing
Just deps -> do
when checkForImportCycles $ void $ uses_ ReportImportCycles deps
ms:mss <- map msrModSummary <$> if fullModSummary
then uses_ GetModSummary (file:deps)
else uses_ GetModSummaryWithoutTimestamps (file:deps)
mss <- map msrModSummary <$> if fullModSummary
then uses_ GetModSummary deps
else uses_ GetModSummaryWithoutTimestamps deps

depSessions <- map hscEnv <$> uses_ GhcSessionDeps deps
let uses_th_qq =
xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
dflags = ms_hspp_opts ms
ifaces <- if uses_th_qq || forceLinkables
then uses_ GetModIface deps
else uses_ GetModIfaceWithoutLinkable deps
ifaces <- uses_ GetModIface deps

let inLoadOrder = map hirHomeMod ifaces
session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions
Expand Down Expand Up @@ -882,13 +874,6 @@ getModIfaceRule = defineEarlyCutoff $ Rule $ \GetModIface f -> do
liftIO $ void $ modifyVar' compiledLinkables $ \old -> extendModuleEnv old mod time
pure res

getModIfaceWithoutLinkableRule :: Rules ()
getModIfaceWithoutLinkableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetModIfaceWithoutLinkable f -> do
mhfr <- use GetModIface f
let mhfr' = fmap (\x -> x{ hirHomeMod = (hirHomeMod x){ hm_linkable = Just (error msg) } }) mhfr
msg = "tried to look at linkable for GetModIfaceWithoutLinkable for " ++ show f
pure (hirIfaceFp <$> mhfr', mhfr')

-- | Also generates and indexes the `.hie` file, along with the `.o` file if needed
-- Invariant maintained is that if the `.hi` file was successfully written, then the
-- `.hie` and `.o` file (if needed) were also successfully written
Expand Down Expand Up @@ -1089,7 +1074,6 @@ mainRule RulesConfig{..} = do
getModIfaceFromDiskRule
getModIfaceFromDiskAndIndexRule
getModIfaceRule
getModIfaceWithoutLinkableRule
getModSummaryRule
isHiFileStableRule
getModuleGraphRule
Expand Down
5 changes: 5 additions & 0 deletions ghcide/test/data/THLoading/A.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module A where
import B (bar)

foo :: ()
foo = bar
4 changes: 4 additions & 0 deletions ghcide/test/data/THLoading/B.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
module B where

bar :: ()
bar = ()
7 changes: 7 additions & 0 deletions ghcide/test/data/THLoading/THA.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
module THA where
import Language.Haskell.TH
import A (foo)

th_a :: DecsQ
th_a = [d| a = foo |]
5 changes: 5 additions & 0 deletions ghcide/test/data/THLoading/THB.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module THB where
import THA

$th_a
1 change: 1 addition & 0 deletions ghcide/test/data/THLoading/hie.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
cradle: {direct: {arguments: ["-package template-haskell", "THA", "THB", "A", "B"]}}
9 changes: 9 additions & 0 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4018,6 +4018,7 @@ thTests =
_ <- createDoc "B.hs" "haskell" sourceB
return ()
, thReloadingTest False
, thLoadingTest
, ignoreInWindowsBecause "Broken in windows" $ thReloadingTest True
-- Regression test for https://github.com/haskell/haskell-language-server/issues/891
, thLinkingTest False
Expand Down Expand Up @@ -4055,6 +4056,14 @@ thTests =
expectDiagnostics [ ( cPath, [(DsWarning, (3, 0), "Top-level binding with no type signature: a :: A")] ) ]
]

-- | Test that all modules have linkables
thLoadingTest :: TestTree
thLoadingTest = testCase "Loading linkables" $ runWithExtraFiles "THLoading" $ \dir -> do
let thb = dir </> "THB.hs"
_ <- openDoc thb "haskell"
expectNoMoreDiagnostics 1


-- | test that TH is reevaluated on typecheck
thReloadingTest :: Bool -> TestTree
thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do
Expand Down
3 changes: 1 addition & 2 deletions plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -540,8 +540,7 @@ runGetSession st nfp = liftIO $ runAction "eval" st $ do
((_, res),_) <- liftIO $ loadSessionFun fp
let env = fromMaybe (error $ "Unknown file: " <> fp) res
ghcSessionDepsConfig = def
{ forceLinkables = True
, checkForImportCycles = False
{ checkForImportCycles = False
, fullModSummary = True
}
res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition ghcSessionDepsConfig env nfp
Expand Down

0 comments on commit abebf26

Please sign in to comment.