Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6d058a69 by Andrea Bedini at 2025-05-21T16:00:51-04:00
Don't fail when ghcversion.h can't be found (#26018)
If ghcversion.h can't be found, don't try to include it. This happens
when there is no rts package in the package db and when -ghcversion-file
argument isn't passed.
Co-authored-by: Syvlain Henry
- - - - -
4 changed files:
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/SysTools/Cpp.hs
- testsuite/tests/driver/Makefile
- testsuite/tests/driver/all.T
Changes:
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -478,7 +478,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
-- very weakly typed, being derived from C--.
["-fno-strict-aliasing"]
- ghcVersionH <- getGhcVersionPathName dflags unit_env
+ ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env
withAtomicRename output_fn $ \temp_outputFilename ->
GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (
@@ -525,7 +525,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
else [])
++ verbFlags
++ cc_opt
- ++ [ "-include", ghcVersionH ]
+ ++ ghcVersionH
++ framework_paths
++ include_paths
++ pkg_extra_cc_opts
=====================================
compiler/GHC/SysTools/Cpp.hs
=====================================
@@ -7,6 +7,7 @@ module GHC.SysTools.Cpp
( doCpp
, CppOpts(..)
, getGhcVersionPathName
+ , getGhcVersionIncludeFlags
, applyCDefs
, offsetIncludePaths
)
@@ -31,7 +32,6 @@ import GHC.Utils.TmpFs
import GHC.Utils.Panic
import Data.Version
-import Data.List (intercalate)
import Data.Maybe
import Control.Monad
@@ -124,10 +124,10 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
[homeUnitEnv_dflags . ue_findHomeUnitEnv uid $ unit_env | uid <- ue_transitiveHomeDeps (ue_currentUnit unit_env) unit_env]
dep_pkg_extra_inputs = [offsetIncludePaths fs (includePaths fs) | fs <- home_pkg_deps]
- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
+ let include_paths_global = map ("-I" ++)
(includePathsGlobal cmdline_include_paths ++ pkg_include_dirs
++ concatMap includePathsGlobal dep_pkg_extra_inputs)
- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
+ let include_paths_quote = map ("-iquote" ++)
(includePathsQuote cmdline_include_paths ++
includePathsQuoteImplicit cmdline_include_paths)
let include_paths = include_paths_quote ++ include_paths_global
@@ -178,8 +178,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags]
-- Default CPP defines in Haskell source
- ghcVersionH <- getGhcVersionPathName dflags unit_env
- let hsSourceCppOpts = [ "-include", ghcVersionH ]
+ ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env
-- MIN_VERSION macros
let uids = explicitUnits unit_state
@@ -202,7 +201,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
cpp_prog ( map GHC.SysTools.Option verbFlags
++ map GHC.SysTools.Option include_paths
- ++ map GHC.SysTools.Option hsSourceCppOpts
+ ++ map GHC.SysTools.Option ghcVersionH
++ map GHC.SysTools.Option target_defs
++ map GHC.SysTools.Option backend_defs
++ map GHC.SysTools.Option th_defs
@@ -265,28 +264,32 @@ generateMacros prefix name version =
_ -> error "take3"
(major1,major2,minor) = take3 $ map show (versionBranch version) ++ repeat "0"
+getGhcVersionIncludeFlags :: DynFlags -> UnitEnv -> IO [String]
+getGhcVersionIncludeFlags dflags unit_env =
+ getGhcVersionPathName dflags unit_env >>= \case
+ Nothing -> pure []
+ Just path -> pure [ "-include", path ]
-- | Find out path to @ghcversion.h@ file
-getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath
-getGhcVersionPathName dflags unit_env = do
- let candidates = case ghcVersionFile dflags of
- -- the user has provided an explicit `ghcversion.h` file to use.
- Just path -> [path]
- -- otherwise, try to find it in the rts' include-dirs.
- -- Note: only in the RTS include-dirs! not all preload units less we may
- -- use a wrong file. See #25106 where a globally installed
- -- /usr/include/ghcversion.h file was used instead of the one provided
- -- by the rts.
- Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of
- Nothing -> []
- Just info -> ( "ghcversion.h") <$> collectIncludeDirs [info]
-
- found <- filterM doesFileExist candidates
- case found of
- [] -> throwGhcExceptionIO (InstallationError
- ("ghcversion.h missing; tried: "
- ++ intercalate ", " candidates))
- (x:_) -> return x
+getGhcVersionPathName :: DynFlags -> UnitEnv -> IO (Maybe FilePath)
+getGhcVersionPathName dflags unit_env = case ghcVersionFile dflags of
+ -- the user has provided an explicit `ghcversion.h` file to use.
+ Just path -> doesFileExist path >>= \case
+ True -> return (Just path)
+ False -> throwGhcExceptionIO (InstallationError ("ghcversion.h not found in: " ++ path))
+ -- otherwise, try to find it in the rts' include-dirs.
+ -- Note: only in the RTS include-dirs! not all preload units less we may
+ -- use a wrong file. See #25106 where a globally installed
+ -- /usr/include/ghcversion.h file was used instead of the one provided
+ -- by the rts.
+ Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of
+ Nothing -> pure Nothing
+ Just info -> do
+ let candidates = ( "ghcversion.h") <$> collectIncludeDirs [info]
+ found <- filterM doesFileExist candidates
+ case found of
+ [] -> pure Nothing
+ (x:_) -> pure (Just x)
applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String]
applyCDefs NoCDefs _ _ = return []
=====================================
testsuite/tests/driver/Makefile
=====================================
@@ -813,3 +813,8 @@ T23339B:
T25382:
"$(TEST_HC)" $(TEST_HC_OPTS) -c T25382.hs
"$(TEST_HC)" $(TEST_HC_OPTS) T25382.o -o main
+
+# Test we can compile C code with an empty package DB
+T26018:
+ touch foo.c
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c foo.c -clear-package-db
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -331,3 +331,4 @@ test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cp
test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S'])
test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c'])
test('T25382', normal, makefile_test, [])
+test('T26018', req_c, makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d058a6948ab62deab69d7249a91cf40...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d058a6948ab62deab69d7249a91cf40...
You're receiving this email because of your account on gitlab.haskell.org.
Marge Bot (＠marge-bot)