From a740869a50b0869a188fc232cc524ee8f351d268 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Wed, 3 Jun 2026 23:42:40 +0200 Subject: [PATCH] Fix transitiveReverseDependencies recursion new was inverted so the recursion never expanded past the first step, leaving typecheckParents to refresh only direct importers on save. --- ghcide-test/data/transitive-recomp/M0.hs | 4 + ghcide-test/data/transitive-recomp/M1.hs | 5 ++ ghcide-test/data/transitive-recomp/M2.hs | 6 ++ ghcide-test/data/transitive-recomp/hie.yaml | 1 + ghcide-test/exe/IfaceTests.hs | 32 +++++++ ghcide-test/exe/UnitTests.hs | 88 ++++++++++++++----- .../IDE/Import/DependencyInformation.hs | 8 +- haskell-language-server.cabal | 1 + 8 files changed, 120 insertions(+), 25 deletions(-) create mode 100644 ghcide-test/data/transitive-recomp/M0.hs create mode 100644 ghcide-test/data/transitive-recomp/M1.hs create mode 100644 ghcide-test/data/transitive-recomp/M2.hs create mode 100644 ghcide-test/data/transitive-recomp/hie.yaml diff --git a/ghcide-test/data/transitive-recomp/M0.hs b/ghcide-test/data/transitive-recomp/M0.hs new file mode 100644 index 0000000000..6cbb7b8655 --- /dev/null +++ b/ghcide-test/data/transitive-recomp/M0.hs @@ -0,0 +1,4 @@ +module M0 (m0val) where + +m0val :: Int +m0val = 0 diff --git a/ghcide-test/data/transitive-recomp/M1.hs b/ghcide-test/data/transitive-recomp/M1.hs new file mode 100644 index 0000000000..847506887e --- /dev/null +++ b/ghcide-test/data/transitive-recomp/M1.hs @@ -0,0 +1,5 @@ +module M1 (m1val) where + +import M0 + +m1val = m0val diff --git a/ghcide-test/data/transitive-recomp/M2.hs b/ghcide-test/data/transitive-recomp/M2.hs new file mode 100644 index 0000000000..3da89e6305 --- /dev/null +++ b/ghcide-test/data/transitive-recomp/M2.hs @@ -0,0 +1,6 @@ +module M2 (m2val) where + +import M1 + +m2val :: Int +m2val = m1val diff --git a/ghcide-test/data/transitive-recomp/hie.yaml b/ghcide-test/data/transitive-recomp/hie.yaml new file mode 100644 index 0000000000..96c71d95b1 --- /dev/null +++ b/ghcide-test/data/transitive-recomp/hie.yaml @@ -0,0 +1 @@ +cradle: {direct: {arguments: ["-Wmissing-signatures", "M0", "M1", "M2"]}} diff --git a/ghcide-test/exe/IfaceTests.hs b/ghcide-test/exe/IfaceTests.hs index 3ba630834e..ca4a0e968f 100644 --- a/ghcide-test/exe/IfaceTests.hs +++ b/ghcide-test/exe/IfaceTests.hs @@ -28,6 +28,7 @@ tests = testGroup "Interface loading tests" , ifaceErrorTest2 , ifaceErrorTest3 , ifaceTHTest + , ifaceTransitivePropagationTest ] @@ -137,6 +138,37 @@ ifaceErrorTest2 = testWithExtraFiles "iface-error-test-2" "recomp" $ \dir -> do expectNoMoreDiagnostics 2 +-- | Saving a file should propagate type errors to its transitive reverse +-- dependencies, not just immediate importers. The fixture is a 3-module chain +-- M0 <- M1 <- M2 where M2 does not import M0 directly. Flipping M0's exported +-- type from Int to Bool must surface a diagnostic in M2. +ifaceTransitivePropagationTest :: TestTree +ifaceTransitivePropagationTest = testWithExtraFiles "iface-transitive-propagation" "transitive-recomp" $ \dir -> do + configureCheckProject False + let m0Path = dir "M0.hs" + m2Path = dir "M2.hs" + m0Source <- liftIO $ readFileUtf8 m0Path + m2Source <- liftIO $ readFileUtf8 m2Path + -- Open M2 first to bring the whole chain (M2 -> M1 -> M0) into the module + -- graph. After this we close M2 so it leaves the FOI set. + m2doc <- createDoc m2Path "haskell" m2Source + expectDiagnostics + [("M1.hs", [(DiagnosticSeverity_Warning, (4, 0), "Top-level binding", Just "GHC-38417")])] + closeDoc m2doc + m0doc <- createDoc m0Path "haskell" m0Source + -- Flip M0's exported value from Int to Bool. + changeDoc m0doc + [TextDocumentContentChangeEvent . InR . TextDocumentContentChangeWholeDocument $ + T.unlines ["module M0 (m0val) where", "m0val :: Bool", "m0val = True"]] + sendNotification SMethod_TextDocumentDidSave (DidSaveTextDocumentParams m0doc Nothing) + -- m1val is type-inferred and becomes Bool, so M2 (which has + -- m2val :: Int = m1val) now fails. The M2 diagnostic only reaches the + -- client if typecheckParents walks the transitive reverse-dep set. + expectDiagnostics + [ ("M1.hs", [(DiagnosticSeverity_Warning, (4, 0), "Top-level binding", Just "GHC-38417")]) + , ("M2.hs", [(DiagnosticSeverity_Error, (5, 8), "Couldn't match expected type 'Int' with actual type 'Bool'", Just "GHC-83865")]) + ] + ifaceErrorTest3 :: TestTree ifaceErrorTest3 = testWithExtraFiles "iface-error-test-3" "recomp" $ \dir -> do let bPath = dir "B.hs" diff --git a/ghcide-test/exe/UnitTests.hs b/ghcide-test/exe/UnitTests.hs index dcd5c170f4..09d6d7c1ba 100644 --- a/ghcide-test/exe/UnitTests.hs +++ b/ghcide-test/exe/UnitTests.hs @@ -1,41 +1,54 @@ module UnitTests (tests) where -import Config (mkIdeTestFs) +import Config (mkIdeTestFs) import Control.Concurrent -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (liftIO) +import qualified Data.HashMap.Strict as HMS +import qualified Data.IntMap.Strict as IntMap +import qualified Data.IntSet as IntSet import Data.IORef -import Data.IORef.Extra (atomicModifyIORef_) +import Data.IORef.Extra (atomicModifyIORef_) import Data.List.Extra -import Data.String (IsString (fromString)) -import qualified Data.Text as T -import Development.IDE.Core.FileStore (getModTime) -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import qualified Development.IDE.Types.Diagnostics as Diagnostics +import Data.String (IsString (fromString)) +import qualified Data.Text as T +import Development.IDE.Core.FileStore (getModTime) +import Development.IDE.Import.DependencyInformation (DependencyInformation (..), + FilePathId (..), + PathIdMap (..), + ShowableModuleEnv (..), + transitiveReverseDependencies) +import Development.IDE.Import.FindImports (ArtifactsLocation (..)) +import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide +import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location import qualified FuzzySearch -import Ide.Logger (Recorder, WithPriority) -import Ide.PluginUtils (pluginDescToIdePlugins) +import GHC.Unit.Module.Env (emptyModuleEnv) +import GHC.Unit.Module.Graph (emptyMG) +import Ide.Logger (Recorder, + WithPriority) +import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types import Language.LSP.Protocol.Message -import Language.LSP.Protocol.Types hiding - (SemanticTokenAbsolute (..), - SemanticTokenRelative (..), - SemanticTokensEdit (..), - mkRange) +import Language.LSP.Protocol.Types hiding + (SemanticTokenAbsolute (..), + SemanticTokenRelative (..), + SemanticTokensEdit (..), + mkRange) import Language.LSP.Test import Network.URI import qualified Progress -import System.IO.Extra hiding (withTempDir) -import System.Mem (performGC) -import Test.Hls (IdeState, def, - runSessionWithServerInTmpDir, - waitForProgressDone) +import System.IO.Extra hiding + (withTempDir) +import System.Mem (performGC) +import Test.Hls (IdeState, def, + runSessionWithServerInTmpDir, + waitForProgressDone) import Test.Hls.FileSystem import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit -import Text.Printf (printf) +import Text.Printf (printf) tests :: TestTree tests = do @@ -97,6 +110,39 @@ tests = do resolution_us <- findResolution_us 1 let msg = printf "Timestamps do not have millisecond resolution: %dus" resolution_us assertBool msg (resolution_us <= 1000) + , testCase "transitiveReverseDependencies follows the chain" $ do + -- Chain: 0 imported by 1, 1 imported by 2, 2 imported by 3. + -- transitiveReverseDependencies of node 0 must contain {1, 2, 3}, + -- not just the immediate reverse-dep {1}. + let path :: Int -> NormalizedFilePath + path i = toNormalizedFilePath' ("/M" ++ show i ++ ".hs") + loc :: Int -> ArtifactsLocation + loc i = ArtifactsLocation (path i) Nothing True Nothing + pathIdMap = PathIdMap + { idToPathMap = IntMap.fromList [(i, loc i) | i <- [0..3]] + , pathToIdMap = HMS.fromList [(path i, FilePathId i) | i <- [0..3]] + , nextFreshId = 4 + } + revDeps = IntMap.fromList + [ (0, IntSet.fromList [1]) + , (1, IntSet.fromList [2]) + , (2, IntSet.fromList [3]) + ] + depInfo = DependencyInformation + { depErrorNodes = IntMap.empty + , depModules = IntMap.empty + , depModuleDeps = IntMap.empty + , depReverseModuleDeps = revDeps + , depPathIdMap = pathIdMap + , depBootMap = IntMap.empty + , depModuleFiles = ShowableModuleEnv emptyModuleEnv + , depModuleGraph = emptyMG + , depTransDepsFingerprints = IntMap.empty + , depTransReverseDepsFingerprints = IntMap.empty + , depImmediateReverseDepsFingerprints = IntMap.empty + } + (sort <$> transitiveReverseDependencies (path 0) depInfo) + @?= Just [path 1, path 2, path 3] , Progress.tests , FuzzySearch.tests ] diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index e4c98003b9..9a4512be86 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -366,11 +366,11 @@ transitiveReverseDependencies file DependencyInformation{..} = do return $ map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty)) where go :: Int -> IntSet -> IntSet - go k i = + go k visited = let outwards = IntMap.findWithDefault IntSet.empty k depReverseModuleDeps - res = IntSet.union i outwards - new = IntSet.difference i outwards - in IntSet.foldr go res new + visited' = IntSet.union visited outwards + new = IntSet.difference outwards visited + in IntSet.foldr go visited' new -- | Immediate reverse dependencies of a file immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath] diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index ff106ab1f6..def5d32e13 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -2032,6 +2032,7 @@ test-suite ghcide-tests , enummapset , extra , filepath + , ghc , ghcide , hls-plugin-api , lens