Commit a01e78cc authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Don't build extra object with -no-hs-main

We don't need to compile/link an additional empty C file when it is not
needed.

This patch may also fix #18938 by avoiding trying to lookup the RTS unit
when there is none (yet) in the unit database.
parent 1109896c
...@@ -87,23 +87,34 @@ mkExtraObj logger dflags unit_state extn xs ...@@ -87,23 +87,34 @@ mkExtraObj logger dflags unit_state extn xs
-- --
-- On Windows, when making a shared library we also may need a DllMain. -- On Windows, when making a shared library we also may need a DllMain.
-- --
mkExtraObjToLinkIntoBinary :: Logger -> DynFlags -> UnitState -> IO FilePath mkExtraObjToLinkIntoBinary :: Logger -> DynFlags -> UnitState -> IO (Maybe FilePath)
mkExtraObjToLinkIntoBinary logger dflags unit_state = do mkExtraObjToLinkIntoBinary logger dflags unit_state = do
when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $
logInfo logger dflags $ withPprStyle defaultUserStyle logInfo logger dflags $ withPprStyle defaultUserStyle
(text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$ (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
text " Call hs_init_ghc() from your main() function to set these options.") text " Call hs_init_ghc() from your main() function to set these options.")
mkExtraObj logger dflags unit_state "c" (showSDoc dflags main) case ghcLink dflags of
where -- Don't try to build the extra object if it is not needed. Compiling the
main -- extra object assumes the presence of the RTS in the unit database
| gopt Opt_NoHsMain dflags = Outputable.empty -- (because the extra object imports Rts.h) but GHC's build system may try
-- to build some helper programs before building and registering the RTS!
-- See #18938 for an example where hp2ps failed to build because of a failed
-- (unsafe) lookup for the RTS in the unit db.
_ | gopt Opt_NoHsMain dflags
-> return Nothing
LinkDynLib
| OSMinGW32 <- platformOS (targetPlatform dflags)
-> mk_extra_obj dllMain
| otherwise | otherwise
= case ghcLink dflags of -> return Nothing
LinkDynLib -> if platformOS (targetPlatform dflags) == OSMinGW32
then dllMain _ -> mk_extra_obj exeMain
else Outputable.empty
_ -> exeMain where
mk_extra_obj = fmap Just . mkExtraObj logger dflags unit_state "c" . showSDoc dflags
exeMain = vcat [ exeMain = vcat [
text "#include <Rts.h>", text "#include <Rts.h>",
......
...@@ -35,6 +35,7 @@ import GHC.Driver.Session ...@@ -35,6 +35,7 @@ import GHC.Driver.Session
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import Control.Monad import Control.Monad
import Data.Maybe
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Static linking, of .o files -- Static linking, of .o files
...@@ -137,7 +138,7 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do ...@@ -137,7 +138,7 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do
let lib_paths = libraryPaths dflags let lib_paths = libraryPaths dflags
let lib_path_opts = map ("-L"++) lib_paths let lib_path_opts = map ("-L"++) lib_paths
extraLinkObj <- mkExtraObjToLinkIntoBinary logger dflags unit_state extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger dflags unit_state
noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger dflags unit_env dep_units noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger dflags unit_env dep_units
let let
...@@ -253,7 +254,8 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do ...@@ -253,7 +254,8 @@ linkBinary' staticLink logger dflags unit_env o_files dep_units = do
rc_objs rc_objs
++ framework_opts ++ framework_opts
++ pkg_lib_path_opts ++ pkg_lib_path_opts
++ extraLinkObj:noteLinkObjs ++ extraLinkObj
++ noteLinkObjs
++ pkg_link_opts ++ pkg_link_opts
++ pkg_framework_opts ++ pkg_framework_opts
++ (if platformOS platform == OSDarwin ++ (if platformOS platform == OSDarwin
......
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