diff options
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, []) |