Commit 880a6b90 authored by Simon Marlow's avatar Simon Marlow

Check the modification times of libraries in --make link step

When linking in --make we check the modification time of the
executable against the modification time of the object files, and only
re-link if any object file is newer.  However, we should also check
the modification times of packages, since the recompilation checker
also tracks dependencies in packages.  

In a GHC build this means that if you recompile stage2 and don't
manage to change any fingerpints, we won't recompile Main but we'll
still re-link it.
parent 17d2260b
......@@ -49,6 +49,7 @@ import ParserCoreUtils ( getCoreModuleName )
import SrcLoc
import FastString
import Data.Either
import Exception
import Data.IORef ( readIORef, writeIORef, IORef )
import GHC.Exts ( Int(..) )
......@@ -295,17 +296,7 @@ link LinkBinary dflags batch_attempt_linking hpt
exe_file = exeFileName dflags
-- if the modification time on the executable is later than the
-- modification times on all of the objects, then omit linking
-- (unless the -fforce-recomp flag was given).
e_exe_time <- IO.try $ getModificationTime exe_file
extra_ld_inputs <- readIORef v_Ld_inputs
extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs
let other_times = map linkableTime linkables
++ [ t' | Right t' <- extra_times ]
linking_needed = case e_exe_time of
Left _ -> True
Right t -> any (t <) other_times
linking_needed <- linkingNeeded dflags linkables pkg_deps
if not (dopt Opt_ForceRecomp dflags) && not linking_needed
then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required."))
......@@ -338,6 +329,51 @@ link other _ _ _ = panicBadLink other
panicBadLink :: GhcLink -> a
panicBadLink other = panic ("link: GHC not built to link this way: " ++
show other)
linkingNeeded :: DynFlags -> [Linkable] -> [PackageId] -> IO Bool
linkingNeeded dflags linkables pkg_deps = do
-- if the modification time on the executable is later than the
-- modification times on all of the objects and libraries, then omit
-- linking (unless the -fforce-recomp flag was given).
let exe_file = exeFileName dflags
e_exe_time <- IO.try $ getModificationTime exe_file
case e_exe_time of
Left _ -> return True
Right t -> do
-- first check object files and extra_ld_inputs
extra_ld_inputs <- readIORef v_Ld_inputs
e_extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs
let (errs,extra_times) = splitEithers e_extra_times
let obj_times = map linkableTime linkables ++ extra_times
if not (null errs) || any (t <) obj_times
then return True
else do
-- next, check libraries. XXX this only checks Haskell libraries,
-- not extra_libraries or -l things from the command line.
let pkg_map = pkgIdMap (pkgState dflags)
pkg_hslibs = [ (libraryDirs c, lib)
| Just c <- map (lookupPackage pkg_map) pkg_deps,
lib <- packageHsLibs dflags c ]
pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs
if any isNothing pkg_libfiles then return True else do
e_lib_times <- mapM (IO.try . getModificationTime)
(catMaybes pkg_libfiles)
let (lib_errs,lib_times) = splitEithers e_lib_times
if not (null lib_errs) || any (t <) lib_times
then return True
else return False
findHSLib :: [String] -> String -> IO (Maybe FilePath)
findHSLib dirs lib = do
let batch_lib_file = "lib" ++ lib <.> "a"
found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
case found of
[] -> return Nothing
(x:_) -> return (Just x)
-- -----------------------------------------------------------------------------
-- Compile files in one-shot mode.
......
......@@ -26,6 +26,7 @@ module Packages (
getPreloadPackagesAnd,
collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
packageHsLibs,
-- * Utils
isDllName
......@@ -640,15 +641,18 @@ getPackageLinkOpts dflags pkgs =
collectLinkOpts :: DynFlags -> [PackageConfig] -> [String]
collectLinkOpts dflags ps = concat (map all_opts ps)
where
libs p = packageHsLibs dflags p ++ extraLibraries p
all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
packageHsLibs :: DynFlags -> PackageConfig -> [String]
packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
where
tag = buildTag dflags
rts_tag = rtsBuildTag dflags
mkDynName | opt_Static = id
| otherwise = (++ ("-ghc" ++ cProjectVersion))
libs p = map (mkDynName . addSuffix) (hsLibraries p)
++ extraLibraries p
all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
addSuffix other_lib = other_lib ++ (expandTag tag)
......
Markdown is supported
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