summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-09-23 12:21:56 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2022-12-08 11:44:41 +0000
commitee599c52b4e3cbf449e3348f2e24d8624defdb07 (patch)
tree09f482f5c851519fdb1f252fb4389d1876399e36
parent08552434da4993c0a47250ce6c5cecddac5f6964 (diff)
downloadhaskell-wip/hackage-bindist.tar.gz
Fix mk_mod_usage_info if the interface file is not already loadedwip/hackage-bindist
In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217
-rw-r--r--compiler/GHC/HsToCore.hs7
-rw-r--r--compiler/GHC/HsToCore/Usage.hs57
-rw-r--r--compiler/GHC/Iface/Make.hs2
-rw-r--r--testsuite/tests/backpack/should_fail/T19244a.stderr22
-rw-r--r--testsuite/tests/determinism/determ024/A.hs6
-rw-r--r--testsuite/tests/determinism/determ024/B.hs7
-rw-r--r--testsuite/tests/determinism/determ024/Makefile11
-rw-r--r--testsuite/tests/determinism/determ024/all.T1
8 files changed, 70 insertions, 43 deletions
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 05487e769e..3c6ec71079 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -41,7 +41,7 @@ import GHC.HsToCore.Coverage
import GHC.HsToCore.Docs
import GHC.Tc.Types
-import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances )
+import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceLoad )
import GHC.Tc.Module ( runTcInteractive )
import GHC.Core.Type
@@ -241,8 +241,9 @@ deSugar hsc_env
; let plugins = hsc_plugins hsc_env
; let fc = hsc_FC hsc_env
; let unit_env = hsc_unit_env hsc_env
- ; usages <- mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names
- dep_files merged needed_mods needed_pkgs
+ ; usages <- initIfaceLoad hsc_env $
+ mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names
+ dep_files merged needed_mods needed_pkgs
-- id_mod /= mod when we are processing an hsig, but hsigs
-- never desugared and compiled (there's no code!)
-- Consequently, this should hold for any ModGuts that make
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index f3eb5ab0b3..498fe888b8 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -15,10 +15,13 @@ import GHC.Driver.Env
import GHC.Tc.Types
+import GHC.Iface.Load
+
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Fingerprint
import GHC.Utils.Panic
+import GHC.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Set ( NameSet, allUses )
@@ -70,18 +73,18 @@ data UsageConfig = UsageConfig
}
mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
- -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IO [Usage]
+ -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IfG [Usage]
mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_files merged needed_links needed_pkgs
= do
- eps <- readIORef (euc_eps (ue_eps unit_env))
- hashes <- mapM getFileHash dependent_files
+ eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env))
+ hashes <- liftIO $ mapM getFileHash dependent_files
let hu = unsafeGetHomeUnit unit_env
hug = ue_home_unit_graph unit_env
-- Dependencies on object files due to TH and plugins
- object_usages <- mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
- let mod_usages = mk_mod_usage_info (eps_PIT eps) uc hug hu this_mod
+ object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
+ mod_usages <- mk_mod_usage_info uc hu this_mod
dir_imp_mods used_names
- usages = mod_usages ++ [ UsageFile { usg_file_path = f
+ let usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash
, usg_file_label = Nothing }
| (f, hash) <- zip dependent_files hashes ]
@@ -189,16 +192,14 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
librarySpecToUsage (DLLPath fn) = traverse (fing Nothing) [fn]
librarySpecToUsage _ = return []
-mk_mod_usage_info :: PackageIfaceTable
- -> UsageConfig
- -> HomeUnitGraph
+mk_mod_usage_info :: UsageConfig
-> HomeUnit
-> Module
-> ImportedMods
-> NameSet
- -> [Usage]
-mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
- = mapMaybe mkUsage usage_mods
+ -> IfG [Usage]
+mk_mod_usage_info uc home_unit this_mod direct_imports used_names
+ = mapMaybeM mkUsageM usage_mods
where
safe_implicit_imps_req = uc_safe_implicit_imps_req uc
@@ -234,22 +235,27 @@ mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
in extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod' [occ]
where occ = nameOccName name
+ mkUsageM :: Module -> IfG (Maybe Usage)
+ mkUsageM mod | mod == this_mod -- We don't care about usages of things in *this* module
+ || moduleUnit mod == interactiveUnit -- ... or in GHCi
+ = return Nothing
+ mkUsageM mod = do
+ iface <- loadSysInterface (text "mk_mod_usage") mod
+ -- Make sure the interface is loaded even if we don't directly use
+ -- any symbols from it, to ensure determinism. See #22217.
+ return $ mkUsage mod iface
+
+
-- We want to create a Usage for a home module if
-- a) we used something from it; has something in used_names
-- b) we imported it, even if we used nothing from it
-- (need to recompile if its export list changes: export_fprint)
- mkUsage :: Module -> Maybe Usage
- mkUsage mod
- | isNothing maybe_iface -- We can't depend on it if we didn't
- -- load its interface.
- || mod == this_mod -- We don't care about usages of
- -- things in *this* module
- = Nothing
-
+ mkUsage :: Module -> ModIface -> Maybe Usage
+ mkUsage mod iface
| not (isHomeModule home_unit mod)
- = Just UsagePackageModule{ usg_mod = mod,
- usg_mod_hash = mod_hash,
- usg_safe = imp_safe }
+ = Just $ UsagePackageModule{ usg_mod = mod,
+ usg_mod_hash = mod_hash,
+ usg_safe = imp_safe }
-- for package modules, we record the module hash only
| (null used_occs
@@ -269,11 +275,6 @@ mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
usg_entities = Map.toList ent_hashs,
usg_safe = imp_safe }
where
- maybe_iface = lookupIfaceByModule hpt pit mod
- -- In one-shot mode, the interfaces for home-package
- -- modules accumulate in the PIT not HPT. Sigh.
-
- Just iface = maybe_iface
finsts_mod = mi_finsts (mi_final_exts iface)
hash_env = mi_hash_fn (mi_final_exts iface)
mod_hash = mi_mod_hash (mi_final_exts iface)
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 7b779f3ea1..ac55220cbf 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -232,7 +232,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
-- but if you pass that in here, we'll decide it's the local
-- module and does not need to be recorded as a dependency.
-- See Note [Identity versus semantic module]
- usages <- mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names
+ usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names
dep_files merged needed_links needed_pkgs
docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
diff --git a/testsuite/tests/backpack/should_fail/T19244a.stderr b/testsuite/tests/backpack/should_fail/T19244a.stderr
index 76f0c86661..5dceaad5f3 100644
--- a/testsuite/tests/backpack/should_fail/T19244a.stderr
+++ b/testsuite/tests/backpack/should_fail/T19244a.stderr
@@ -13,7 +13,17 @@
Instantiating user[Map=ordmap:Map]
[1 of 2] Compiling Map[sig] ( user/Map.hsig, T19244a.out/user/user-GzloW2NeDdA2M0V8qzN4g2/Map.o )
-T19244a.bkp:9:9: error:
+T19244a.bkp:22:9: error:
+ • Type constructor ‘Key’ has conflicting definitions in the module
+ and its hsig file
+ Main module: type Key :: * -> Constraint
+ type Key = GHC.Classes.Ord :: * -> Constraint
+ Hsig file: type Key :: forall {k}. k -> Constraint
+ class Key k1
+ The types have different kinds
+ • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
+
+<no location info>: error:
• Type constructor ‘Map’ has conflicting definitions in the module
and its hsig file
Main module: type role Map nominal representational
@@ -31,16 +41,6 @@ T19244a.bkp:9:9: error:
The types have different kinds
• while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
-T19244a.bkp:22:9: error:
- • Type constructor ‘Key’ has conflicting definitions in the module
- and its hsig file
- Main module: type Key :: * -> Constraint
- type Key = GHC.Classes.Ord :: * -> Constraint
- Hsig file: type Key :: forall {k}. k -> Constraint
- class Key k1
- The types have different kinds
- • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
-
<no location info>: error:
• Identifier ‘lookup’ has conflicting definitions in the module
and its hsig file
diff --git a/testsuite/tests/determinism/determ024/A.hs b/testsuite/tests/determinism/determ024/A.hs
new file mode 100644
index 0000000000..bd275761e2
--- /dev/null
+++ b/testsuite/tests/determinism/determ024/A.hs
@@ -0,0 +1,6 @@
+module A
+( isExtensionOf
+, stripExtension
+) where
+
+import System.FilePath.Posix
diff --git a/testsuite/tests/determinism/determ024/B.hs b/testsuite/tests/determinism/determ024/B.hs
new file mode 100644
index 0000000000..02c9081858
--- /dev/null
+++ b/testsuite/tests/determinism/determ024/B.hs
@@ -0,0 +1,7 @@
+module B
+( isExtensionOf
+, stripExtension
+) where
+
+import System.FilePath
+
diff --git a/testsuite/tests/determinism/determ024/Makefile b/testsuite/tests/determinism/determ024/Makefile
new file mode 100644
index 0000000000..300a408394
--- /dev/null
+++ b/testsuite/tests/determinism/determ024/Makefile
@@ -0,0 +1,11 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+determ024:
+ $(RM) A.hi A.o B.hi B.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 B.hs
+ '$(TEST_HC)' --show-iface B.hi > B_clean_iface
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 A.hs B.hs -fforce-recomp
+ '$(TEST_HC)' --show-iface B.hi > B_dirty_iface
+ diff B_clean_iface B_dirty_iface
diff --git a/testsuite/tests/determinism/determ024/all.T b/testsuite/tests/determinism/determ024/all.T
new file mode 100644
index 0000000000..eaa79f6e6c
--- /dev/null
+++ b/testsuite/tests/determinism/determ024/all.T
@@ -0,0 +1 @@
+test('determ024', [extra_files(['A.hs', 'B.hs'])], makefile_test, ['determ024'])