Commit 1d1dd3fb authored by Matthew Pickering's avatar Matthew Pickering Committed by Marge Bot
Browse files

Fix recompilation checking for multiple home units

The key part of this change is to store a UnitId in the
`UsageHomeModule` and `UsageHomeModuleInterface`.

* Fine-grained dependency tracking is used if the dependency comes from
  any home unit.
* We actually look up the right module when checking whether we need to
  recompile in the `UsageHomeModuleInterface` case.

These scenarios are both checked by the new tests (
multipleHomeUnits_recomp and multipleHomeUnits_recomp_th )

Fixes #22675
parent eee3bf05
......@@ -40,6 +40,7 @@ import Data.IORef
import Data.List (sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
import GHC.Linker.Types
import GHC.Unit.Finder
......@@ -82,7 +83,8 @@ mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_fi
hug = ue_home_unit_graph unit_env
-- Dependencies on object files due to TH and plugins
object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
mod_usages <- mk_mod_usage_info uc hu this_mod
let all_home_ids = ue_all_home_unit_ids unit_env
mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod
dir_imp_mods used_names
let usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash
......@@ -184,7 +186,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
case miface of
Nothing -> pprPanic "mkObjectUsage" (ppr m)
Just iface ->
return $ UsageHomeModuleInterface (moduleName m) (mi_iface_hash (mi_final_exts iface))
return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash (mi_final_exts iface))
librarySpecToUsage :: LibrarySpec -> IO [Usage]
librarySpecToUsage (Objects os) = traverse (fing Nothing) os
......@@ -194,11 +196,12 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
mk_mod_usage_info :: UsageConfig
-> HomeUnit
-> Set.Set UnitId
-> Module
-> ImportedMods
-> NameSet
-> IfG [Usage]
mk_mod_usage_info uc home_unit this_mod direct_imports used_names
mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
= mapMaybeM mkUsageM usage_mods
where
safe_implicit_imps_req = uc_safe_implicit_imps_req uc
......@@ -252,7 +255,7 @@ mk_mod_usage_info uc home_unit this_mod direct_imports used_names
-- (need to recompile if its export list changes: export_fprint)
mkUsage :: Module -> ModIface -> Maybe Usage
mkUsage mod iface
| not (isHomeModule home_unit mod)
| toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids
= Just $ UsagePackageModule{ usg_mod = mod,
usg_mod_hash = mod_hash,
usg_safe = imp_safe }
......@@ -270,6 +273,7 @@ mk_mod_usage_info uc home_unit this_mod direct_imports used_names
| otherwise
= Just UsageHomeModule {
usg_mod_name = moduleName mod,
usg_unit_id = toUnitId (moduleUnit mod),
usg_mod_hash = mod_hash,
usg_exports = export_hash,
usg_entities = Map.toList ent_hashs,
......
......@@ -1172,7 +1172,7 @@ pprUsage :: Usage -> SDoc
pprUsage usage@UsagePackageModule{}
= pprUsageImport usage usg_mod
pprUsage usage@UsageHomeModule{}
= pprUsageImport usage usg_mod_name $$
= pprUsageImport usage (\u -> mkModule (usg_unit_id u) (usg_mod_name u)) $$
nest 2 (
maybe Outputable.empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
......@@ -1184,7 +1184,9 @@ pprUsage usage@UsageFile{}
pprUsage usage@UsageMergedRequirement{}
= hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
pprUsage usage@UsageHomeModuleInterface{}
= hsep [text "implementation", ppr (usg_mod_name usage), ppr (usg_iface_hash usage)]
= hsep [text "implementation", ppr (usg_mod_name usage)
, ppr (usg_unit_id usage)
, ppr (usg_iface_hash usage)]
pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport usage usg_mod'
......
......@@ -403,7 +403,7 @@ checkVersions hsc_env mod_summary iface
when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }
}
; recomp <- checkList [checkModUsage (hsc_FC hsc_env) (homeUnitAsUnit home_unit) u
; recomp <- checkList [checkModUsage (hsc_FC hsc_env) u
| u <- mi_usages iface]
; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do {
; return $ UpToDateItem iface
......@@ -682,7 +682,7 @@ tryGetModIface doc_msg mod
= do -- Load the imported interface if possible
logger <- getLogger
let doc_str = sep [text doc_msg, ppr mod]
liftIO $ trace_hi_diffs logger (text "Checking interface for module" <+> ppr mod)
liftIO $ trace_hi_diffs logger (text "Checking interface for module" <+> ppr mod <+> ppr (moduleUnit mod))
mb_iface <- loadInterface doc_str mod ImportBySystem
-- Load the interface, but don't complain on failure;
......@@ -701,8 +701,8 @@ tryGetModIface doc_msg mod
-- | Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.
checkModUsage :: FinderCache -> Unit -> Usage -> IfG RecompileRequired
checkModUsage _ _this_pkg UsagePackageModule{
checkModUsage :: FinderCache -> Usage -> IfG RecompileRequired
checkModUsage _ UsagePackageModule{
usg_mod = mod,
usg_mod_hash = old_mod_hash } = do
logger <- getLogger
......@@ -714,25 +714,28 @@ checkModUsage _ _this_pkg UsagePackageModule{
-- recompile. This is safe but may entail more recompilation when
-- a dependent package has changed.
checkModUsage _ _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
logger <- getLogger
needInterface mod $ \iface -> do
let reason = ModuleChangedRaw (moduleName mod)
checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
checkModUsage _ this_pkg UsageHomeModuleInterface{ usg_mod_name = mod_name, usg_iface_hash = old_mod_hash } = do
let mod = mkModule this_pkg mod_name
checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name
, usg_unit_id = uid
, usg_iface_hash = old_mod_hash } = do
let mod = mkModule (RealUnit (Definite uid)) mod_name
logger <- getLogger
needInterface mod $ \iface -> do
let reason = ModuleChangedIface mod_name
checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash (mi_final_exts iface))
checkModUsage _ this_pkg UsageHomeModule{
checkModUsage _ UsageHomeModule{
usg_mod_name = mod_name,
usg_unit_id = uid,
usg_mod_hash = old_mod_hash,
usg_exports = maybe_old_export_hash,
usg_entities = old_decl_hash }
= do
let mod = mkModule this_pkg mod_name
let mod = mkModule (RealUnit (Definite uid)) mod_name
logger <- getLogger
needInterface mod $ \iface -> do
let
......@@ -757,9 +760,9 @@ checkModUsage _ this_pkg UsageHomeModule{
, up_to_date logger (text " Great! The bits I use are up to date")
]
checkModUsage fc _this_pkg UsageFile{ usg_file_path = file,
usg_file_hash = old_hash,
usg_file_label = mlabel } =
checkModUsage fc UsageFile{ usg_file_path = file,
usg_file_hash = old_hash,
usg_file_label = mlabel } =
liftIO $
handleIO handler $ do
new_hash <- lookupFileCache fc file
......
......@@ -14,6 +14,7 @@ module GHC.Unit.Env
, ue_setUnits
, ue_setUnitFlags
, ue_unit_dbs
, ue_all_home_unit_ids
, ue_setUnitDbs
, ue_hpt
, ue_homeUnit
......@@ -442,7 +443,8 @@ ue_unitHomeUnit_maybe uid ue_env =
ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env
ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId
ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph
-- -------------------------------------------------------
-- Query and modify the currently active unit
-- -------------------------------------------------------
......@@ -462,6 +464,7 @@ ue_setActiveUnit u ue_env = assertUnitEnvInvariant $ ue_env
ue_currentUnit :: UnitEnv -> UnitId
ue_currentUnit = ue_current_unit
-- -------------------------------------------------------
-- Operations on arbitrary elements of the home unit graph
-- -------------------------------------------------------
......
......@@ -255,6 +255,8 @@ data Usage
| UsageHomeModule {
usg_mod_name :: ModuleName,
-- ^ Name of the module
usg_unit_id :: UnitId,
-- ^ UnitId of the HomeUnit the module is from
usg_mod_hash :: Fingerprint,
-- ^ Cached module ABI fingerprint (corresponds to mi_mod_hash).
-- This may be out dated after recompilation was avoided, but is
......@@ -291,6 +293,8 @@ data Usage
| UsageHomeModuleInterface {
usg_mod_name :: ModuleName
-- ^ Name of the module
, usg_unit_id :: UnitId
-- ^ UnitId of the HomeUnit the module is from
, usg_iface_hash :: Fingerprint
-- ^ The *interface* hash of the module, not the ABI hash.
-- This changes when anything about the interface (and hence the
......@@ -330,6 +334,7 @@ instance Binary Usage where
put_ bh usg@UsageHomeModule{} = do
putByte bh 1
put_ bh (usg_mod_name usg)
put_ bh (usg_unit_id usg)
put_ bh (usg_mod_hash usg)
put_ bh (usg_exports usg)
put_ bh (usg_entities usg)
......@@ -349,6 +354,7 @@ instance Binary Usage where
put_ bh usg@UsageHomeModuleInterface{} = do
putByte bh 4
put_ bh (usg_mod_name usg)
put_ bh (usg_unit_id usg)
put_ bh (usg_iface_hash usg)
get bh = do
......@@ -361,11 +367,12 @@ instance Binary Usage where
return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
1 -> do
nm <- get bh
uid <- get bh
mod <- get bh
exps <- get bh
ents <- get bh
safe <- get bh
return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod, usg_unit_id = uid,
usg_exports = exps, usg_entities = ents, usg_safe = safe }
2 -> do
fp <- get bh
......@@ -378,8 +385,9 @@ instance Binary Usage where
return UsageMergedRequirement { usg_mod = mod, usg_mod_hash = hash }
4 -> do
mod <- get bh
uid <- get bh
hash <- get bh
return UsageHomeModuleInterface { usg_mod_name = mod, usg_iface_hash = hash }
return UsageHomeModuleInterface { usg_mod_name = mod, usg_unit_id = uid, usg_iface_hash = hash }
i -> error ("Binary.get(Usage): " ++ show i)
......
......@@ -30,4 +30,9 @@ multipleHomeUnits004_recomp: clean
multipleHomeUnitsModuleVisibility: clean
! '$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -unit @unitMV -unit @unitMV-import
multipleHomeUnits_recomp: clean
'$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -unit @unitRecomp -unit @unitDep
# Doesn't cause recomp when TH is not involved
echo "recomp=()" >> Dep.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -fhide-source-paths -unit @unitRecomp -unit @unitDep
module Recomp where
import Dep
qux = foo
{-# LANGUAGE TemplateHaskell #-}
module RecompTH where
import Dep
qux = $(const [| () |] foo)
......@@ -59,3 +59,10 @@ test('multipleHomeUnitsPackageImports',
test('MHU_OptionsGHC', normal, compile_fail, [''])
test('multipleHomeUnits_loop', [extra_files([ 'a/', 'unitA', 'loop', 'unitLoop'])], multiunit_compile, [['unitA', 'unitLoop'], '-fhide-source-paths'])
test('multipleHomeUnits_recomp', [copy_files,extra_files([ 'Recomp.hs', 'unitRecomp', 'unitDep', 'Dep.hs'])], makefile_test, [])
test('multipleHomeUnits_recomp_th', [filter_stdout_lines(r'.*Compiling.*'), copy_files, extra_files(['thRecomp.script', 'unitRecompTH', 'unitDep', 'RecompTH.hs', 'Dep.hs', '../../ghci/shell.hs']) , extra_run_opts('-v1 -unit @unitRecompTH -unit @unitDep')], ghci_script, ['thRecomp.script'])
[1 of 2] Compiling Dep[dep]
[2 of 2] Compiling Recomp[recomp]
[1 of 2] Compiling Dep[dep] [Source file changed]
GHCi, version 9.7.20230119: https://www.haskell.org/ghc/ :? for help
[1 of 2] Compiling Dep ( Dep.hs, interpreted )[dep]
[2 of 2] Compiling RecompTH ( RecompTH.hs, interpreted )[recomp]
Ok, two modules loaded.
ghci> ghci> ghci> [1 of 2] Compiling Dep ( Dep.hs, interpreted )[dep] [Source file changed]
[2 of 2] Compiling RecompTH ( RecompTH.hs, interpreted )[recomp] [Dep changed (interface)]
Ok, two modules loaded.
ghci> Leaving GHCi.
shell s = System.Process.rawSystem "sh" ["-c", s] >> return ()
shell "echo \"recomp=()\" >> Dep.hs"
:r
-i Dep -outputdir=dep -this-unit-id dep
-i Recomp -outputdir=recomp -this-unit-id recomp -package-id dep
-i RecompTH -outputdir=recomp -this-unit-id recomp -package-id dep
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment