From abebf26de746b5c462d5ec4c5264e62ceacb7856 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 22 Nov 2021 01:58:22 +0000 Subject: [PATCH] Fix regression in GhcSessionDeps (#2380) * 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 --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 9 ------- ghcide/src/Development/IDE/Core/Rules.hs | 24 ++++--------------- ghcide/test/data/THLoading/A.hs | 5 ++++ ghcide/test/data/THLoading/B.hs | 4 ++++ ghcide/test/data/THLoading/THA.hs | 7 ++++++ ghcide/test/data/THLoading/THB.hs | 5 ++++ ghcide/test/data/THLoading/hie.yaml | 1 + ghcide/test/exe/Main.hs | 9 +++++++ .../src/Ide/Plugin/Eval/CodeLens.hs | 3 +-- 9 files changed, 36 insertions(+), 31 deletions(-) create mode 100644 ghcide/test/data/THLoading/A.hs create mode 100644 ghcide/test/data/THLoading/B.hs create mode 100644 ghcide/test/data/THLoading/THA.hs create mode 100644 ghcide/test/data/THLoading/THB.hs create mode 100644 ghcide/test/data/THLoading/hie.yaml diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 5d98fd873b..53f66ee7e3 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -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) @@ -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 diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 43cb1803cc..1052bc1ac2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -41,7 +41,6 @@ module Development.IDE.Core.Rules( loadGhcSession, getModIfaceFromDiskRule, getModIfaceRule, - getModIfaceWithoutLinkableRule, getModSummaryRule, isHiFileStableRule, getModuleGraphRule, @@ -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 } @@ -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 @@ -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 @@ -1089,7 +1074,6 @@ mainRule RulesConfig{..} = do getModIfaceFromDiskRule getModIfaceFromDiskAndIndexRule getModIfaceRule - getModIfaceWithoutLinkableRule getModSummaryRule isHiFileStableRule getModuleGraphRule diff --git a/ghcide/test/data/THLoading/A.hs b/ghcide/test/data/THLoading/A.hs new file mode 100644 index 0000000000..3559bfc26c --- /dev/null +++ b/ghcide/test/data/THLoading/A.hs @@ -0,0 +1,5 @@ +module A where +import B (bar) + +foo :: () +foo = bar diff --git a/ghcide/test/data/THLoading/B.hs b/ghcide/test/data/THLoading/B.hs new file mode 100644 index 0000000000..a18753c265 --- /dev/null +++ b/ghcide/test/data/THLoading/B.hs @@ -0,0 +1,4 @@ +module B where + +bar :: () +bar = () diff --git a/ghcide/test/data/THLoading/THA.hs b/ghcide/test/data/THLoading/THA.hs new file mode 100644 index 0000000000..d74bdd697e --- /dev/null +++ b/ghcide/test/data/THLoading/THA.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +module THA where +import Language.Haskell.TH +import A (foo) + +th_a :: DecsQ +th_a = [d| a = foo |] diff --git a/ghcide/test/data/THLoading/THB.hs b/ghcide/test/data/THLoading/THB.hs new file mode 100644 index 0000000000..8d50b01eac --- /dev/null +++ b/ghcide/test/data/THLoading/THB.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module THB where +import THA + +$th_a diff --git a/ghcide/test/data/THLoading/hie.yaml b/ghcide/test/data/THLoading/hie.yaml new file mode 100644 index 0000000000..5d67e9708c --- /dev/null +++ b/ghcide/test/data/THLoading/hie.yaml @@ -0,0 +1 @@ +cradle: {direct: {arguments: ["-package template-haskell", "THA", "THB", "A", "B"]}} diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index de0c3e9761..99909b479b 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -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 @@ -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 diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index ef9541eba0..5912bba2d7 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -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