summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Driver/Main.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline.hs66
-rw-r--r--compiler/GHC/Driver/Session.hs42
-rw-r--r--compiler/GHC/Iface/Load.hs58
-rw-r--r--compiler/GHC/Iface/Recomp.hs30
-rw-r--r--compiler/GHC/Unit/Module/Location.hs6
-rw-r--r--compiler/GHC/Unit/Module/ModSummary.hs6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile42
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stdout4
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeA.stdout6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeB.stdout3
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001/test.T11
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/A.hs6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/B1.hs-boot5
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/B2.hs-boot4
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/C.hs9
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/Makefile19
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicToo001boot/test.T6
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/Makefile28
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/README.md5
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/Setup.hs2
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.stderr9
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/p/CHANGELOG.md5
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/p/Lib.hs4
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/p/p.cabal34
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/q/CHANGELOG.md5
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/AppLib.hs5
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/Main.hs8
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/q/q.cabal34
-rw-r--r--testsuite/tests/driver/dynamicToo/dynamicTooMake/test.T9
32 files changed, 336 insertions, 151 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 1d36a83445..365807fad8 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -989,7 +989,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
--
let no_change = old_iface == Just (mi_iface_hash (mi_final_exts iface))
- dt <- dynamicTooState dflags
+ let dt = dynamicTooState dflags
when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger $
hang (text "Writing interface(s):") 2 $ vcat
@@ -1003,7 +1003,6 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
write_iface dflags iface
case dt of
DT_Dont -> return ()
- DT_Failed -> return ()
DT_Dyn -> panic "Unexpected DT_Dyn state when writing simple interface"
DT_OK -> write_iface (setDynamicNow dflags) iface
else case dt of
@@ -1011,7 +1010,6 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
DT_OK | not no_change -> write_iface dflags iface
-- FIXME: see no_change' comment above
DT_Dyn -> write_iface dflags iface
- DT_Failed | not (dynamicNow dflags) -> write_iface dflags iface
_ -> return ()
when (gopt Opt_WriteHie dflags) $ do
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 59cb28eccc..55b6a28970 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -720,63 +720,6 @@ fullPipeline pipe_env hsc_env pp_fn src_flavour = do
<- use (T_HscRecomp pipe_env hsc_env' input_fn src_flavour)
hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status)
-checkDynamicToo :: P m => HscEnv -> (HscEnv -> m (ModIface, Maybe Linkable)) -> (ModIface, Maybe Linkable) -> m (ModIface, Maybe Linkable)
-checkDynamicToo hsc_env dyn_too_rerun res = do
- liftIO (dynamicTooState (hsc_dflags hsc_env)) >>= \case
- DT_Dont -> return res
- DT_Dyn -> return res
- DT_OK -> return res
- -- If we are compiling a Haskell module with -dynamic-too, we
- -- first try the "fast path": that is we compile the non-dynamic
- -- version and at the same time we check that interfaces depended
- -- on exist both for the non-dynamic AND the dynamic way. We also
- -- check that they have the same hash.
- -- If they don't, dynamicTooState is set to DT_Failed.
- -- See GHC.Iface.Load.checkBuildDynamicToo
- -- If they do, in the end we produce both the non-dynamic and
- -- dynamic outputs.
- --
- -- If this "fast path" failed, we execute the whole pipeline
- -- again, this time for the dynamic way *only*. To do that we
- -- just set the dynamicNow bit from the start to ensure that the
- -- dynamic DynFlags fields are used and we disable -dynamic-too
- -- (its state is already set to DT_Failed so it wouldn't do much
- -- anyway).
- DT_Failed
- -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
- | OSMinGW32 <- platformOS (targetPlatform dflags) -> return res
- | otherwise -> do
- liftIO (debugTraceMsg logger 4
- (text "Running the full pipeline again for -dynamic-too"))
- hsc_env' <- liftIO (resetHscEnv hsc_env)
- dyn_too_rerun hsc_env'
- where
- dflags = hsc_dflags hsc_env
- logger = hsc_logger hsc_env
-
--- | Enable dynamic-too, reset EPS
-resetHscEnv :: HscEnv -> IO HscEnv
-resetHscEnv hsc_env = do
- let init_dflags = hsc_dflags hsc_env
- dflags0 = flip gopt_unset Opt_BuildDynamicToo
- $ setDynamicNow -- -dynamic
- $ (init_dflags { hiSuf_ = dynHiSuf_ init_dflags -- -hisuf = -dynhisuf
- , objectSuf_ = dynObjectSuf_ init_dflags -- -osuf = -dynosuf
- })
- hsc_env' <- newHscEnv dflags0
- (dbs,unit_state,home_unit,mconstants) <- initUnits (hsc_logger hsc_env) dflags0 Nothing
- dflags1 <- updatePlatformConstants dflags0 mconstants
- unit_env0 <- initUnitEnv (ghcNameVersion dflags1) (targetPlatform dflags1)
- let unit_env = unit_env0
- { ue_home_unit = Just home_unit
- , ue_units = unit_state
- , ue_unit_dbs = Just dbs
- }
- let hsc_env'' = hscSetFlags dflags1 $ hsc_env'
- { hsc_unit_env = unit_env
- }
- return hsc_env''
-
-- | Everything after preprocess
hscPipeline :: P m => PipeEnv -> ((HscEnv, ModSummary, HscRecompStatus)) -> m (ModIface, Maybe Linkable)
hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do
@@ -785,10 +728,7 @@ hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do
HscRecompNeeded mb_old_hash -> do
(tc_result, warnings) <- use (T_Hsc hsc_env_with_plugins mod_sum)
hscBackendAction <- use (T_HscPostTc hsc_env_with_plugins mod_sum tc_result warnings mb_old_hash )
- res <- hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction
- -- Once the pipeline has finished, check to see if -dynamic-too failed and
- -- rerun again if it failed but just the `--dynamic` way.
- checkDynamicToo hsc_env_with_plugins (\hsc' -> hscPipeline pipe_env (hsc', mod_sum, hsc_recomp_status)) res
+ hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction
hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, Maybe Linkable)
hscBackendPipeline pipe_env hsc_env mod_sum result =
@@ -801,11 +741,9 @@ hscBackendPipeline pipe_env hsc_env mod_sum result =
-- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing
_ -> do
res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result
- liftIO (dynamicTooState (hsc_dflags hsc_env)) >>= \case
- DT_OK -> do
+ when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env)) $ do
let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow"
() <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result
- _ -> return ()
return res
hscGenBackendPipeline :: P m
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 3342091bfa..8f1cd31ece 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -37,7 +37,7 @@ module GHC.Driver.Session (
xopt_DuplicateRecordFields,
xopt_FieldSelectors,
lang_set,
- DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed,
+ DynamicTooState(..), dynamicTooState, setDynamicNow,
sccProfilingEnabled,
DynFlags(..),
outputFile, objectSuf, ways,
@@ -530,7 +530,6 @@ data DynFlags = DynFlags {
hiSuf_ :: String,
hieSuf :: String,
- dynamicTooFailed :: IORef Bool,
dynObjectSuf_ :: String,
dynHiSuf_ :: String,
@@ -1020,33 +1019,21 @@ positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
-- need Template-Haskell and GHC is dynamically linked (cf
-- GHC.Driver.Pipeline.compileOne').
--
--- This somewhat explains why we have "dynamicTooFailed :: IORef Bool" in
--- DynFlags: when -dynamic-too is enabled, we try to build the dynamic objects,
--- but we may fail and we shouldn't abort the whole compilation because the user
--- may not even have asked for -dynamic-too in the first place. So instead we
--- use this global variable to indicate that we can't build dynamic objects and
--- compilation continues to build non-dynamic objects only. At the end of the
--- non-dynamic pipeline, if this value indicates that the dynamic compilation
--- failed, we run the whole pipeline again for the dynamic way (except on
--- Windows...). See GHC.Driver.Pipeline.runPipeline.
+-- We used to try and fall back from a dynamic-too failure but this feature
+-- didn't work as expected (#20446) so it was removed to simplify the
+-- implementation and not obscure latent bugs.
data DynamicTooState
= DT_Dont -- ^ Don't try to build dynamic objects too
- | DT_Failed -- ^ Won't try to generate dynamic objects for some reason
| DT_OK -- ^ Will still try to generate dynamic objects
| DT_Dyn -- ^ Currently generating dynamic objects (in the backend)
deriving (Eq,Show,Ord)
-dynamicTooState :: MonadIO m => DynFlags -> m DynamicTooState
+dynamicTooState :: DynFlags -> DynamicTooState
dynamicTooState dflags
- | not (gopt Opt_BuildDynamicToo dflags) = return DT_Dont
- | otherwise = do
- failed <- liftIO $ readIORef (dynamicTooFailed dflags)
- if failed
- then return DT_Failed
- else if dynamicNow dflags
- then return DT_Dyn
- else return DT_OK
+ | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont
+ | dynamicNow dflags = DT_Dyn
+ | otherwise = DT_OK
setDynamicNow :: DynFlags -> DynFlags
setDynamicNow dflags0 =
@@ -1054,21 +1041,12 @@ setDynamicNow dflags0 =
{ dynamicNow = True
}
-setDynamicTooFailed :: MonadIO m => DynFlags -> m ()
-setDynamicTooFailed dflags =
- liftIO $ writeIORef (dynamicTooFailed dflags) True
-
-----------------------------------------------------------------------------
-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
- let -- We can't build with dynamic-too on Windows, as labels before
- -- the fork point are different depending on whether we are
- -- building dynamically or not.
- platformCanGenerateDynamicToo
- = platformOS (targetPlatform dflags) /= OSMinGW32
- refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo)
+ let
refRtldInfo <- newIORef Nothing
refRtccInfo <- newIORef Nothing
refRtasmInfo <- newIORef Nothing
@@ -1089,7 +1067,6 @@ initDynFlags dflags = do
(useColor dflags, colScheme dflags)
tmp_dir <- normalise <$> getTemporaryDirectory
return dflags{
- dynamicTooFailed = refDynamicTooFailed,
useUnicode = useUnicode',
useColor = useColor',
canUseColor = stderrSupportsAnsiColors,
@@ -1163,7 +1140,6 @@ defaultDynFlags mySettings llvmConfig =
hiSuf_ = "hi",
hieSuf = "hie",
- dynamicTooFailed = panic "defaultDynFlags: No dynamicTooFailed",
dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn,
dynHiSuf_ = "dyn_hi",
dynamicNow = False,
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 64df715755..38d7511103 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -10,6 +10,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
-- | Loading interface files
module GHC.Iface.Load (
@@ -900,23 +901,24 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
-- Look for the file
mb_found <- liftIO (findExactModule fc fopts unit_state home_unit mod)
case mb_found of
- InstalledFound loc mod -> do
- -- Found file, so read it
- let file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
+ InstalledFound (addBootSuffixLocn_maybe hi_boot_file -> loc) mod -> do
-- See Note [Home module load error]
if isHomeInstalledModule home_unit mod &&
not (isOneShot (ghcMode dflags))
then return (Failed (homeModError mod loc))
else do
- r <- read_file logger name_cache unit_state dflags wanted_mod file_path
+ r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
case r of
Failed _
- -> return ()
+ -> return r
Succeeded (iface,_fp)
- -> load_dynamic_too_maybe logger name_cache unit_state
- dflags wanted_mod
- hi_boot_file iface loc
- return r
+ -> do
+ r2 <- load_dynamic_too_maybe logger name_cache unit_state
+ (setDynamicNow dflags) wanted_mod
+ iface loc
+ case r2 of
+ Failed sdoc -> return (Failed sdoc)
+ Succeeded {} -> return r
err -> do
trace_if logger (text "...not found")
return $ Failed $ cannotFindInterface
@@ -928,30 +930,32 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
err
-- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> ModLocation -> IO ()
-load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod is_boot iface loc
+load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
+load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
-- Indefinite interfaces are ALWAYS non-dynamic.
- | not (moduleIsDefinite (mi_module iface)) = return ()
- | otherwise = dynamicTooState dflags >>= \case
- DT_Dont -> return ()
- DT_Failed -> return ()
- DT_Dyn -> load_dynamic_too logger name_cache unit_state dflags wanted_mod iface file_path
- DT_OK -> load_dynamic_too logger name_cache unit_state (setDynamicNow dflags) wanted_mod iface file_path
- where
- file_path = addBootSuffix_maybe is_boot (ml_dyn_hi_file loc)
+ | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
+ | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
+ | otherwise = return (Succeeded ())
-load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> FilePath -> IO ()
-load_dynamic_too logger name_cache unit_state dflags wanted_mod iface dynFilePath = do
- read_file logger name_cache unit_state dflags wanted_mod dynFilePath >>= \case
+load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ())
+load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
+ read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
Succeeded (dynIface, _)
| mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
- -> return ()
+ -> return (Succeeded ())
| otherwise ->
- do trace_if logger (text "Dynamic hash doesn't match")
- setDynamicTooFailed dflags
+ do return $ (Failed $ dynamicHashMismatchError wanted_mod loc)
Failed err ->
- do trace_if logger (text "Failed to load dynamic interface file:" $$ err)
- setDynamicTooFailed dflags
+ do return $ (Failed $ ((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err))
+
+
+dynamicHashMismatchError :: Module -> ModLocation -> SDoc
+dynamicHashMismatchError wanted_mod loc =
+ vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod)
+ , text "Normal interface file from" <+> text (ml_hi_file loc)
+ , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc)
+ , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ]
+
read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
read_file logger name_cache unit_state dflags wanted_mod file_path = do
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index f71d9f812e..5e7e687087 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -152,6 +152,8 @@ data RecompReason
| MissingBytecode
| MissingObjectFile
| MissingDynObjectFile
+ | MissingDynHiFile
+ | MismatchedDynHiFile
deriving (Eq)
instance Outputable RecompReason where
@@ -180,6 +182,8 @@ instance Outputable RecompReason where
MissingBytecode -> text "Missing bytecode"
MissingObjectFile -> text "Missing object file"
MissingDynObjectFile -> text "Missing dynamic object file"
+ MissingDynHiFile -> text "Missing dynamic interface file"
+ MismatchedDynHiFile -> text "Mismatched dynamic interface file"
recompileRequired :: RecompileRequired -> Bool
recompileRequired UpToDate = False
@@ -227,12 +231,11 @@ check_old_iface hsc_env mod_summary maybe_iface
trace_if logger (text "We already have the old interface for" <+>
ppr (ms_mod mod_summary))
return maybe_iface
- Nothing -> loadIface
+ Nothing -> loadIface dflags (msHiFilePath mod_summary)
- loadIface = do
- let iface_path = msHiFilePath mod_summary
+ loadIface read_dflags iface_path = do
let ncu = hsc_NC hsc_env
- read_result <- readIface dflags ncu (ms_mod mod_summary) iface_path
+ read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path
case read_result of
Failed err -> do
trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 err)
@@ -241,6 +244,23 @@ check_old_iface hsc_env mod_summary maybe_iface
Succeeded iface -> do
trace_if logger (text "Read the interface file" <+> text iface_path)
return $ Just iface
+ check_dyn_hi :: ModIface
+ -> IfG (RecompileRequired, Maybe a)
+ -> IfG (RecompileRequired, Maybe a)
+ check_dyn_hi normal_iface recomp_check | gopt Opt_BuildDynamicToo dflags = do
+ res <- recomp_check
+ case fst res of
+ UpToDate -> do
+ maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary)
+ case maybe_dyn_iface of
+ Nothing -> return (RecompBecause MissingDynHiFile, Nothing)
+ Just dyn_iface | mi_iface_hash (mi_final_exts dyn_iface)
+ /= mi_iface_hash (mi_final_exts normal_iface)
+ -> return (RecompBecause MismatchedDynHiFile, Nothing)
+ Just {} -> return res
+ _ -> return res
+ check_dyn_hi _ recomp_check = recomp_check
+
src_changed
| gopt Opt_ForceRecomp dflags = True
@@ -273,7 +293,7 @@ check_old_iface hsc_env mod_summary maybe_iface
-- should check versions because some packages
-- might have changed or gone away.
Just iface ->
- checkVersions hsc_env mod_summary iface
+ check_dyn_hi iface $ checkVersions hsc_env mod_summary iface
-- | Check if a module is still the same 'version'.
--
diff --git a/compiler/GHC/Unit/Module/Location.hs b/compiler/GHC/Unit/Module/Location.hs
index 866ccf127a..4d70b43b21 100644
--- a/compiler/GHC/Unit/Module/Location.hs
+++ b/compiler/GHC/Unit/Module/Location.hs
@@ -3,6 +3,7 @@ module GHC.Unit.Module.Location
( ModLocation(..)
, addBootSuffix
, addBootSuffix_maybe
+ , addBootSuffixLocn_maybe
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
@@ -86,6 +87,11 @@ addBootSuffix_maybe is_boot path = case is_boot of
IsBoot -> addBootSuffix path
NotBoot -> path
+addBootSuffixLocn_maybe :: IsBootInterface -> ModLocation -> ModLocation
+addBootSuffixLocn_maybe is_boot locn = case is_boot of
+ IsBoot -> addBootSuffixLocn locn
+ _ -> locn
+
-- | Add the @-boot@ suffix to all file paths associated with the module
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn locn
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index 9cf736a37a..20d61ad4f8 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -16,6 +16,7 @@ module GHC.Unit.Module.ModSummary
, ms_home_srcimps
, ms_home_imps
, msHiFilePath
+ , msDynHiFilePath
, msHsFilePath
, msObjFilePath
, msDynObjFilePath
@@ -151,12 +152,11 @@ ms_home_imps = home_imps . ms_imps
-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
-- the ms_hs_hash and imports can, of course, change
-msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
+msHsFilePath, msDynHiFilePath, msHiFilePath, msObjFilePath, msDynObjFilePath :: ModSummary -> FilePath
msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
msHiFilePath ms = ml_hi_file (ms_location ms)
+msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms)
msObjFilePath ms = ml_obj_file (ms_location ms)
-
-msDynObjFilePath :: ModSummary -> FilePath
msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms)
-- | Did this 'ModSummary' originate from a hs-boot file?
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile
index 30971cf752..ee0d464440 100644
--- a/testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile
@@ -4,10 +4,14 @@ include $(TOP)/mk/test.mk
TEST_HC_OPTS_DYN = -dynamic -hisuf dyn_hi -osuf dyn_o
+checkExists = [ -f $1 ] || echo $1 missing
+
.PHONY: dynamicToo001
# -dynamic-too should notice that the interface files for B don't match,
-# and so compile the dyn way separately. This means that the right value
-# of B.b should get inlined.
+# so an error is issued.
+#
+# In the past this used to compile the dyn way separately. This means that the "right" value
+# of B.b should get inlined. (See #20446 for reasons why this was removed).
dynamicToo001:
"$(TEST_HC)" $(TEST_HC_OPTS) -O -c A.hs
"$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c A.hs
@@ -15,9 +19,33 @@ dynamicToo001:
"$(TEST_HC)" $(TEST_HC_OPTS) -O -c B.hs
cp B2.hs B.hs
"$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c B.hs
- "$(TEST_HC)" $(TEST_HC_OPTS) -O -c C.hs -dynamic-too
- "$(TEST_HC)" $(TEST_HC_OPTS) A.o B.o C.o -o s
- "$(TEST_HC)" $(TEST_HC_OPTS) A.dyn_o B.dyn_o C.dyn_o -o d
- ./s
- ./d
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c C.hs -dynamic-too || true
+# "$(TEST_HC)" $(TEST_HC_OPTS) A.o B.o C.o -o s
+# "$(TEST_HC)" $(TEST_HC_OPTS) A.dyn_o B.dyn_o C.dyn_o -o d
+# ./s
+# ./d
+
+
+# Missing a .dyn_hi file and using --make mode
+.PHONY: dynamicToo001MakeA
+dynamicToo001MakeA:
+ cp B1.hs B.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O C.hs -dynamic-too
+ rm B.dyn_hi
+ # Should recompile
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O C.hs -dynamic-too
+ $(call checkExists,B.dyn_hi)
+
+# Should notice that B.hi and B.dyn_hi are different, and recompile B
+.PHONY: dynamicToo001MakeB
+dynamicToo001MakeB:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c A.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c A.hs
+ cp B1.hs B.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c B.hs
+ cp B2.hs B.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c B.hs
+ cp B1.hs B.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O C.hs -dynamic-too
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr
new file mode 100644
index 0000000000..349b5f2816
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr
@@ -0,0 +1,6 @@
+
+C.hs:5:1: error:
+ Dynamic hash doesn't match for ‘B’
+ Normal interface file from ./B.hi
+ Dynamic interface file from ./B.dyn_hi
+ You probably need to recompile ‘B’
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stdout b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stdout
deleted file mode 100644
index e7aea0735f..0000000000
--- a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stdout
+++ /dev/null
@@ -1,4 +0,0 @@
-'a'
-'b'
-'a'
-'c'
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeA.stdout b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeA.stdout
new file mode 100644
index 0000000000..d80c899cb1
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeA.stdout
@@ -0,0 +1,6 @@
+[1 of 3] Compiling A ( A.hs, A.o, A.dyn_o )
+[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o )
+[3 of 3] Compiling Main ( C.hs, C.o, C.dyn_o )
+Linking C ...
+[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o ) [Missing dynamic interface file]
+Linking C ...
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeB.stdout b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeB.stdout
new file mode 100644
index 0000000000..56caf28582
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001MakeB.stdout
@@ -0,0 +1,3 @@
+[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o ) [Mismatched dynamic interface file]
+[3 of 3] Compiling Main ( C.hs, C.o, C.dyn_o )
+Linking C ...
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/test.T b/testsuite/tests/driver/dynamicToo/dynamicToo001/test.T
index 67b1566b54..2c9636bc89 100644
--- a/testsuite/tests/driver/dynamicToo/dynamicToo001/test.T
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/test.T
@@ -1,6 +1,7 @@
-
-test('dynamicToo001',
- [extra_files(['A.hs', 'B.hs', 'B1.hs', 'B2.hs', 'C.hs']),
+opts = [ extra_files(['A.hs', 'B1.hs', 'B2.hs', 'C.hs']),
when(opsys('mingw32'), expect_broken(7665)), unless(have_vanilla(), skip),
- unless(have_dynamic(), skip)],
- makefile_test, [])
+ unless(have_dynamic(), skip) ]
+
+test('dynamicToo001', [opts], makefile_test, [])
+test('dynamicToo001MakeA', [opts], makefile_test, [])
+test('dynamicToo001MakeB', [opts], makefile_test, [])
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/A.hs b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/A.hs
new file mode 100644
index 0000000000..f76166afab
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/A.hs
@@ -0,0 +1,6 @@
+
+module A where
+
+a :: Char
+a = 'a'
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B1.hs-boot b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B1.hs-boot
new file mode 100644
index 0000000000..4cbf619183
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B1.hs-boot
@@ -0,0 +1,5 @@
+
+module B where
+
+b :: Char
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B2.hs-boot b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B2.hs-boot
new file mode 100644
index 0000000000..6f0d8a4aec
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/B2.hs-boot
@@ -0,0 +1,4 @@
+module B where
+
+e :: Char
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/C.hs b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/C.hs
new file mode 100644
index 0000000000..40fb0f7695
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/C.hs
@@ -0,0 +1,9 @@
+
+module Main where
+
+import A
+import {-# SOURCE #-} B
+
+main = do print a
+ print b
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/Makefile
new file mode 100644
index 0000000000..94ead80abc
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/Makefile
@@ -0,0 +1,19 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+TEST_HC_OPTS_DYN = -dynamic -hisuf dyn_hi -osuf dyn_o
+
+.PHONY: dynamicToo001boot
+# -dynamic-too should notice that the interface files for B.hs-boot don't match,
+# and issue an error. This is to check the path calculations are correct for boot files.
+dynamicToo001boot:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c A.hs
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c A.hs
+ cp B1.hs-boot B.hs-boot
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c B.hs-boot
+ cp B2.hs-boot B.hs-boot
+ "$(TEST_HC)" $(TEST_HC_OPTS) $(TEST_HC_OPTS_DYN) -O -c B.hs-boot
+ # This step fails because the hash of B1 and B2 is different
+ "$(TEST_HC)" $(TEST_HC_OPTS) -O -c C.hs -dynamic-too || true
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr
new file mode 100644
index 0000000000..8b17cac27a
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr
@@ -0,0 +1,6 @@
+
+C.hs:5:1: error:
+ Dynamic hash doesn't match for ‘B’
+ Normal interface file from ./B.hi-boot
+ Dynamic interface file from ./B.dyn_hi-boot
+ You probably need to recompile ‘B’
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/test.T b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/test.T
new file mode 100644
index 0000000000..bca0be654f
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/test.T
@@ -0,0 +1,6 @@
+
+test('dynamicToo001boot',
+ [extra_files(['A.hs', 'B1.hs-boot', 'B2.hs-boot', 'C.hs']),
+ when(opsys('mingw32'), expect_broken(7665)), unless(have_vanilla(), skip),
+ unless(have_dynamic(), skip)],
+ makefile_test, [])
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/Makefile b/testsuite/tests/driver/dynamicToo/dynamicTooMake/Makefile
new file mode 100644
index 0000000000..8e24b5a31c
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/Makefile
@@ -0,0 +1,28 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP='$(PWD)/Setup' -v0
+CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' --enable-executable-dynamic
+
+dynamicTooMake: clean
+ '$(GHC_PKG)' init tmp.d
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup
+ # build p
+ rm -rf p/dist
+ (cd p; $(CONFIGURE) --enable-shared --ipid "p-0.1")
+ (cd p; $(SETUP) build)
+ (cd p; $(SETUP) copy)
+ (cd p; $(SETUP) register)
+ (cd p; echo "q = 0" >> Lib.hs)
+ # build p, but only rebuild hi
+ (cd p; $(CONFIGURE) --disable-shared --ipid "p-0.1")
+ (cd p; $(SETUP) build)
+ (cd p; $(SETUP) copy)
+ (cd p; $(SETUP) register)
+ (cd q; $(CONFIGURE) --disable-shared --ipid "q-0.1")
+ # build q, should be an error as p has mismatched .hi and .dyn_hi files
+ (cd q; $(SETUP) build) || true
+
+clean :
+ $(RM) -r tmp.d inst dist Setup$(exeext)
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/README.md b/testsuite/tests/driver/dynamicToo/dynamicTooMake/README.md
new file mode 100644
index 0000000000..5b9ecd01f1
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/README.md
@@ -0,0 +1,5 @@
+Reproducer for broken implementation of DT_Failed
+
+```
+./run
+```
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/Setup.hs b/testsuite/tests/driver/dynamicToo/dynamicTooMake/Setup.hs
new file mode 100644
index 0000000000..9a994af677
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.stderr b/testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.stderr
new file mode 100644
index 0000000000..23225fc4fc
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.stderr
@@ -0,0 +1,9 @@
+Warning: -rtsopts and -with-rtsopts have no effect with -shared.
+ Call hs_init_ghc() from your main() function to set these options.
+
+app/Main.hs:4:1: error:
+ Dynamic hash doesn't match for ‘Lib’
+ Normal interface file from /run/user/1000/ghctest-hbhb_f3v/test spaces/testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.run/inst/lib/x86_64-linux-ghc-9.3.20210922/p-0.1/Lib.hi
+ Dynamic interface file from /run/user/1000/ghctest-hbhb_f3v/test spaces/testsuite/tests/driver/dynamicToo/dynamicTooMake/dynamicTooMake.run/inst/lib/x86_64-linux-ghc-9.3.20210922/p-0.1/Lib.dyn_hi
+ You probably need to recompile ‘Lib’
+make: *** [Makefile:26: dynamicTooMake] Error 1
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/CHANGELOG.md b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/CHANGELOG.md
new file mode 100644
index 0000000000..9ede8b27d4
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for p
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/Lib.hs b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/Lib.hs
new file mode 100644
index 0000000000..4e718cafbf
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/Lib.hs
@@ -0,0 +1,4 @@
+module Lib where
+
+{-# NOINLINE l #-}
+l = 1
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/p.cabal b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/p.cabal
new file mode 100644
index 0000000000..a0d6c17515
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/p/p.cabal
@@ -0,0 +1,34 @@
+cabal-version: 2.4
+name: p
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author: Matthew Pickering
+maintainer: matthewtpickering@gmail.com
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+library
+ exposed-modules: Lib
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base >=4.14.1.0 && <5
+ hs-source-dirs: .
+ default-language: Haskell2010
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/CHANGELOG.md b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/CHANGELOG.md
new file mode 100644
index 0000000000..62632c5376
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for q
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/AppLib.hs b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/AppLib.hs
new file mode 100644
index 0000000000..acbae9417c
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/AppLib.hs
@@ -0,0 +1,5 @@
+module AppLib where
+
+a = 10
+
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/Main.hs b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/Main.hs
new file mode 100644
index 0000000000..ea2b9aef96
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/app/Main.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import AppLib
+import Lib
+
+main :: IO ()
+main = print (a + l )
+
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/q.cabal b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/q.cabal
new file mode 100644
index 0000000000..723e1082d5
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/q/q.cabal
@@ -0,0 +1,34 @@
+cabal-version: 2.4
+name: q
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author: Matthew Pickering
+maintainer: matthewtpickering@gmail.com
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+library
+
+ -- Modules included in this executable, other than Main.
+ exposed-modules: AppLib Main
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ ghc-options: -dynamic-too
+ build-depends: base >=4.14.1.0 && < 5, p
+ hs-source-dirs: app
+ default-language: Haskell2010
diff --git a/testsuite/tests/driver/dynamicToo/dynamicTooMake/test.T b/testsuite/tests/driver/dynamicToo/dynamicTooMake/test.T
new file mode 100644
index 0000000000..f771282e69
--- /dev/null
+++ b/testsuite/tests/driver/dynamicToo/dynamicTooMake/test.T
@@ -0,0 +1,9 @@
+
+test('dynamicTooMake',
+ [extra_files(['p', 'q', 'Setup.hs']),
+ when(opsys('mingw32'), expect_broken(7665)), unless(have_vanilla(), skip),
+ unless(have_dynamic(), skip),
+ copy_files,
+ grep_errmsg("Dynamic hash")
+ ],
+ makefile_test, [])