diff options
| -rw-r--r-- | compiler/GHC/HsToCore.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Usage.hs | 57 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Make.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/backpack/should_fail/T19244a.stderr | 22 | ||||
| -rw-r--r-- | testsuite/tests/determinism/determ024/A.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/determinism/determ024/B.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/determinism/determ024/Makefile | 11 | ||||
| -rw-r--r-- | testsuite/tests/determinism/determ024/all.T | 1 |
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']) |