Fix #16511: changes in interface dependencies should trigger recompilation

If the union of dependencies of imported modules change, the `mi_deps`
field of the interface files should change as well. Because of that, we
need to check for changes in this in recompilation checker which we are
not doing right now. This adds a checks for that.

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'])