summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/iface/MkIface.hs100
-rw-r--r--compiler/main/GhcMake.hs22
-rw-r--r--compiler/main/HscTypes.hs25
-rw-r--r--testsuite/tests/driver/T16511/A.hs8
-rw-r--r--testsuite/tests/driver/T16511/B1.hs4
-rw-r--r--testsuite/tests/driver/T16511/B2.hs3
-rw-r--r--testsuite/tests/driver/T16511/C.hs4
-rw-r--r--testsuite/tests/driver/T16511/D.hs6
-rw-r--r--testsuite/tests/driver/T16511/T16511.script12
-rw-r--r--testsuite/tests/driver/T16511/T16511.stdout6
-rw-r--r--testsuite/tests/driver/T16511/all.T2
11 files changed, 160 insertions, 32 deletions
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 40b6d025a1..261a8bfca2 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -115,6 +115,7 @@ import Control.Monad
import Data.Function
import Data.List
import qualified Data.Map as Map
+import qualified Data.Set as Set
import Data.Ord
import Data.IORef
import System.Directory
@@ -1177,8 +1178,8 @@ recompileRequired _ = True
-- is equivalent to the current source file the user asked us to compile.
-- If the same, we can avoid recompilation. We return a tuple where the
-- first element is a bool saying if we should recompile the object file
--- and the second is maybe the interface file, where Nothng means to
--- rebuild the interface file not use the exisitng one.
+-- and the second is maybe the interface file, where Nothing means to
+-- rebuild the interface file and not use the existing one.
checkOldIface
:: HscEnv
-> ModSummary
@@ -1486,11 +1487,30 @@ checkMergedSignatures mod_summary iface = do
-- - a new home module has been added that shadows a package module
-- See bug #1372.
--
+-- In addition, we also check if the union of dependencies of the imported
+-- modules has any difference to the previous set of dependencies. We would need
+-- to recompile in that case also since the `mi_deps` field of ModIface needs
+-- to be updated to match that information. This is one of the invariants
+-- of interface files (see https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#interface-file-invariants).
+-- See bug #16511.
+--
-- Returns (RecompBecause <textual reason>) if recompilation is required.
checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
checkDependencies hsc_env summary iface
- = checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
- where
+ = do
+ checkList $
+ [ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
+ , do
+ (recomp, mnames_seen) <- runUntilRecompRequired $ map
+ checkForNewHomeDependency
+ (ms_home_imps summary)
+ case recomp of
+ UpToDate -> do
+ let
+ seen_home_deps = Set.unions $ map Set.fromList mnames_seen
+ checkIfAllOldHomeDependenciesAreSeen seen_home_deps
+ _ -> return recomp]
+ where
prev_dep_mods = dep_mods (mi_deps iface)
prev_dep_plgn = dep_plgins (mi_deps iface)
prev_dep_pkgs = dep_pkgs (mi_deps iface)
@@ -1522,12 +1542,74 @@ checkDependencies hsc_env summary iface
where pkg = moduleUnitId mod
_otherwise -> return (RecompBecause reason)
+ old_deps = Set.fromList $ map fst $ filter (not . snd) prev_dep_mods
+ isOldHomeDeps = flip Set.member old_deps
+ checkForNewHomeDependency (L _ mname) = do
+ let
+ mod = mkModule this_pkg mname
+ str_mname = moduleNameString mname
+ reason = str_mname ++ " changed"
+ -- We only want to look at home modules to check if any new home dependency
+ -- pops in and thus here, skip modules that are not home. Checking
+ -- membership in old home dependencies suffice because the `dep_missing`
+ -- check already verified that all imported home modules are present there.
+ if not (isOldHomeDeps mname)
+ then return (UpToDate, [])
+ else do
+ mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> do
+ let mnames = mname:(map fst $ filter (not . snd) $
+ dep_mods $ mi_deps imported_iface)
+ case find (not . isOldHomeDeps) mnames of
+ Nothing -> return (UpToDate, mnames)
+ Just new_dep_mname -> do
+ traceHiDiffs $
+ text "imported home module " <> quotes (ppr mod) <>
+ text " has a new dependency " <> quotes (ppr new_dep_mname)
+ return (RecompBecause reason, [])
+ return $ fromMaybe (MustCompile, []) mb_result
+
+ -- Performs all recompilation checks in the list until a check that yields
+ -- recompile required is encountered. Returns the list of the results of
+ -- all UpToDate checks.
+ runUntilRecompRequired [] = return (UpToDate, [])
+ runUntilRecompRequired (check:checks) = do
+ (recompile, value) <- check
+ if recompileRequired recompile
+ then return (recompile, [])
+ else do
+ (recomp, values) <- runUntilRecompRequired checks
+ return (recomp, value:values)
+
+ checkIfAllOldHomeDependenciesAreSeen seen_deps = do
+ let unseen_old_deps = Set.difference
+ old_deps
+ seen_deps
+ if not (null unseen_old_deps)
+ then do
+ let missing_dep = Set.elemAt 0 unseen_old_deps
+ traceHiDiffs $
+ text "missing old home dependency " <> quotes (ppr missing_dep)
+ return $ RecompBecause "missing old dependency"
+ else return UpToDate
+
needInterface :: Module -> (ModIface -> IfG RecompileRequired)
- -> IfG RecompileRequired
+ -> IfG RecompileRequired
needInterface mod continue
+ = do
+ mb_recomp <- getFromModIface
+ "need version info for"
+ mod
+ continue
+ case mb_recomp of
+ Nothing -> return MustCompile
+ Just recomp -> return recomp
+
+getFromModIface :: String -> Module -> (ModIface -> IfG a)
+ -> IfG (Maybe a)
+getFromModIface doc_msg mod getter
= do -- Load the imported interface if possible
- let doc_str = sep [text "need version info for", ppr mod]
- traceHiDiffs (text "Checking usages for module" <+> ppr mod)
+ let doc_str = sep [text doc_msg, ppr mod]
+ traceHiDiffs (text "Checking innterface for module" <+> ppr mod)
mb_iface <- loadInterface doc_str mod ImportBySystem
-- Load the interface, but don't complain on failure;
@@ -1537,12 +1619,12 @@ needInterface mod continue
Failed _ -> do
traceHiDiffs (sep [text "Couldn't load interface for module",
ppr mod])
- return MustCompile
+ return Nothing
-- Couldn't find or parse a module mentioned in the
-- old interface file. Don't complain: it might
-- just be that the current module doesn't need that
-- import and it's been deleted
- Succeeded iface -> continue iface
+ Succeeded iface -> Just <$> getter iface
-- | Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index d4b5cb0559..8767a6e99c 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -2255,28 +2255,6 @@ msDeps s =
concat [ [(m,IsBoot), (m,NotBoot)] | m <- ms_home_srcimps s ]
++ [ (m,NotBoot) | m <- ms_home_imps s ]
-home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
-home_imps imps = [ lmodname | (mb_pkg, lmodname) <- imps,
- isLocal mb_pkg ]
- where isLocal Nothing = True
- isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
- isLocal _ = False
-
-ms_home_allimps :: ModSummary -> [ModuleName]
-ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
-
--- | Like 'ms_home_imps', but for SOURCE imports.
-ms_home_srcimps :: ModSummary -> [Located ModuleName]
-ms_home_srcimps = home_imps . ms_srcimps
-
--- | All of the (possibly) home module imports from a
--- 'ModSummary'; that is to say, each of these module names
--- could be a home import if an appropriately named file
--- existed. (This is in contrast to package qualified
--- imports, which are guaranteed not to be home imports.)
-ms_home_imps :: ModSummary -> [Located ModuleName]
-ms_home_imps = home_imps . ms_imps
-
-----------------------------------------------------------------------------
-- Summarising modules
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index e2dbcb0ecf..a9e9bcb363 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -33,7 +33,8 @@ module HscTypes (
ForeignSrcLang(..),
phaseForeignLanguage,
- ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
+ ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, ms_home_imps,
+ home_imps, ms_home_allimps, ms_home_srcimps, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
SourceModified(..), isTemplateHaskellOrQQNonBoot,
@@ -2800,6 +2801,28 @@ ms_imps ms =
where
mk_additional_import mod_nm = (Nothing, noLoc mod_nm)
+home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
+home_imps imps = [ lmodname | (mb_pkg, lmodname) <- imps,
+ isLocal mb_pkg ]
+ where isLocal Nothing = True
+ isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
+ isLocal _ = False
+
+ms_home_allimps :: ModSummary -> [ModuleName]
+ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
+
+-- | Like 'ms_home_imps', but for SOURCE imports.
+ms_home_srcimps :: ModSummary -> [Located ModuleName]
+ms_home_srcimps = home_imps . ms_srcimps
+
+-- | All of the (possibly) home module imports from a
+-- 'ModSummary'; that is to say, each of these module names
+-- could be a home import if an appropriately named file
+-- existed. (This is in contrast to package qualified
+-- imports, which are guaranteed not to be home imports.)
+ms_home_imps :: ModSummary -> [Located ModuleName]
+ms_home_imps = home_imps . ms_imps
+
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done. The point is that the summariser will have to cpp/unlit/whatever
diff --git a/testsuite/tests/driver/T16511/A.hs b/testsuite/tests/driver/T16511/A.hs
new file mode 100644
index 0000000000..4d3f7a3742
--- /dev/null
+++ b/testsuite/tests/driver/T16511/A.hs
@@ -0,0 +1,8 @@
+module A (mainA) where
+
+import B
+
+mainA :: IO ()
+mainA = do
+ putStrLn "Hello"
+ putStrLn name
diff --git a/testsuite/tests/driver/T16511/B1.hs b/testsuite/tests/driver/T16511/B1.hs
new file mode 100644
index 0000000000..f290969805
--- /dev/null
+++ b/testsuite/tests/driver/T16511/B1.hs
@@ -0,0 +1,4 @@
+module B (name) where
+
+name :: String
+name = "Samantha"
diff --git a/testsuite/tests/driver/T16511/B2.hs b/testsuite/tests/driver/T16511/B2.hs
new file mode 100644
index 0000000000..43f012c5db
--- /dev/null
+++ b/testsuite/tests/driver/T16511/B2.hs
@@ -0,0 +1,3 @@
+module B (C.name) where
+
+import qualified C
diff --git a/testsuite/tests/driver/T16511/C.hs b/testsuite/tests/driver/T16511/C.hs
new file mode 100644
index 0000000000..34283b3701
--- /dev/null
+++ b/testsuite/tests/driver/T16511/C.hs
@@ -0,0 +1,4 @@
+module C where
+
+name :: String
+name = "Samantha"
diff --git a/testsuite/tests/driver/T16511/D.hs b/testsuite/tests/driver/T16511/D.hs
new file mode 100644
index 0000000000..46ca0ee009
--- /dev/null
+++ b/testsuite/tests/driver/T16511/D.hs
@@ -0,0 +1,6 @@
+module D where
+
+import A
+
+main :: IO ()
+main = mainA
diff --git a/testsuite/tests/driver/T16511/T16511.script b/testsuite/tests/driver/T16511/T16511.script
new file mode 100644
index 0000000000..f6a48e99e9
--- /dev/null
+++ b/testsuite/tests/driver/T16511/T16511.script
@@ -0,0 +1,12 @@
+:! rm B.hs 2> /dev/null
+:! rm *.o 2> /dev/null
+:! rm *.hi 2> /dev/null
+:! cp B1.hs B.hs
+:load D.hs
+main
+:! cp B2.hs B.hs
+:reload
+main
+:! cp B1.hs B.hs
+:reload
+main
diff --git a/testsuite/tests/driver/T16511/T16511.stdout b/testsuite/tests/driver/T16511/T16511.stdout
new file mode 100644
index 0000000000..c54cfe1f12
--- /dev/null
+++ b/testsuite/tests/driver/T16511/T16511.stdout
@@ -0,0 +1,6 @@
+Hello
+Samantha
+Hello
+Samantha
+Hello
+Samantha
diff --git a/testsuite/tests/driver/T16511/all.T b/testsuite/tests/driver/T16511/all.T
new file mode 100644
index 0000000000..52b1503d76
--- /dev/null
+++ b/testsuite/tests/driver/T16511/all.T
@@ -0,0 +1,2 @@
+test('T16511', [extra_files(['B1.hs', 'B2.hs', 'D.hs', 'A.hs', 'C.hs']), ],
+ ghci_script, ['T16511.script'])
View Lorry Controller Status