Commit 15b26223 authored by Andrey Mokhov's avatar Andrey Mokhov Committed by Marge Bot

Fix cyclic dependencies when using --configure

This resolves #16809 (#16809).

This patch removes the unnecessary dependency on configure-generated
flags `windowsHost`, `osxHost` and `iosHost`, using the information
provided by the module `System.Info` instead.

We also take care to use the `CrossCompiling` flag generated by the
configure script only after the latter had a chance to run.
parent 581cbc28
Pipeline #7581 passed with stages
in 405 minutes and 16 seconds
......@@ -28,7 +28,6 @@ import Hadrian.Utilities
import Base
import Context
import Oracles.Flag
import Oracles.Setting
import Packages
-- | C compiler can be used in two different modes:
......@@ -179,7 +178,6 @@ instance H.Builder Builder where
Ghc _ Stage0 -> generatedGhcDependencies Stage0
Ghc _ stage -> do
root <- buildRoot
win <- windowsHost
touchyPath <- programPath (vanillaContext Stage0 touchy)
unlitPath <- builderPath Unlit
ghcgens <- generatedGhcDependencies stage
......@@ -191,8 +189,8 @@ instance H.Builder Builder where
return $ [ unlitPath ]
++ ghcdeps
++ ghcgens
++ [ touchyPath | win ]
++ [ root -/- mingwStamp | win ]
++ [ touchyPath | windowsHost ]
++ [ root -/- mingwStamp | windowsHost ]
-- proxy for the entire mingw toolchain that
-- we have in inplace/mingw initially, and then at
-- root -/- mingw.
......@@ -331,9 +329,8 @@ systemBuilderPath builder = case builder of
++ quote key ++ " is not specified" ++ inCfg
return "" -- TODO: Use a safe interface.
else do
win <- windowsHost
fullPath <- lookupInPath path
case (win, hasExtension fullPath) of
case (windowsHost, hasExtension fullPath) of
(False, _ ) -> return fullPath
(True , True ) -> fixAbsolutePathOnWindows fullPath
(True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe)
......
......@@ -14,7 +14,7 @@ import Development.Shake
import Development.Shake.Classes
import GHC.Generics
import Hadrian.Expression
import Oracles.Setting
import Hadrian.Utilities
-- | Tar can be used to 'Create' an archive or 'Extract' from it.
data TarMode = Create | Extract deriving (Eq, Generic, Show)
......
......@@ -28,7 +28,7 @@ module Hadrian.Utilities (
renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn,
-- * Miscellaneous
(<&>), (%%>), cmdLineLengthLimit,
(<&>), (%%>), cmdLineLengthLimit, windowsHost, osxHost, iosHost,
-- * Useful re-exports
Dynamic, fromDynamic, toDyn, TypeRep, typeOf
......@@ -47,7 +47,6 @@ import Development.Shake hiding (Normal)
import Development.Shake.Classes
import Development.Shake.FilePath
import System.Environment (lookupEnv)
import System.Info.Extra
import qualified Control.Exception.Base as IO
import qualified Data.HashMap.Strict as Map
......@@ -231,9 +230,21 @@ infix 1 %%>
-- 20000. Hence, 200000 seems like a sensible limit. On other operating systems
-- we currently use the 4194304 setting.
cmdLineLengthLimit :: Int
cmdLineLengthLimit | isWindows = 31000
| isMac = 200000
| otherwise = 4194304
cmdLineLengthLimit | IO.isWindows = 31000
| IO.isMac = 200000
| otherwise = 4194304
-- | Check if the host OS is Windows.
windowsHost :: Bool
windowsHost = IO.isWindows
-- | Check if the host OS is Mac OS.
osxHost :: Bool
osxHost = IO.isMac
-- | Check if the host OS is iOS.
iosHost :: Bool
iosHost = IO.os == "ios"
-- | Insert a value into Shake's type-indexed map.
insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
......
......@@ -2,10 +2,8 @@ module Oracles.Setting (
configFile, Setting (..), SettingList (..), setting, settingList, getSetting,
getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
hostSupportsRPaths, topDirectory, libsuf, ghcVersionStage,
SettingsFileSetting (..),
settingsFileSetting
ghcCanonVersion, cmdLineLengthLimit, hostSupportsRPaths, topDirectory,
libsuf, ghcVersionStage, SettingsFileSetting (..), settingsFileSetting
) where
import Hadrian.Expression
......@@ -209,14 +207,6 @@ anyTargetArch = matchSetting TargetArch
anyHostOs :: [String] -> Action Bool
anyHostOs = matchSetting HostOs
-- | Check whether the host OS setting is set to @"ios"@.
iosHost :: Action Bool
iosHost = anyHostOs ["ios"]
-- | Check whether the host OS setting is set to @"darwin"@.
osxHost :: Action Bool
osxHost = anyHostOs ["darwin"]
-- | Check whether the host OS supports the @-rpath@ linker option when
-- using dynamic linking.
--
......@@ -225,10 +215,6 @@ osxHost = anyHostOs ["darwin"]
hostSupportsRPaths :: Action Bool
hostSupportsRPaths = anyHostOs ["linux", "darwin", "freebsd"]
-- | Check whether the host OS setting is set to @"mingw32"@ or @"cygwin32"@.
windowsHost :: Action Bool
windowsHost = anyHostOs ["mingw32", "cygwin32"]
-- | Check whether the target supports GHCi.
ghcWithInterpreter :: Action Bool
ghcWithInterpreter = do
......
......@@ -212,8 +212,7 @@ libffiBuildPath stage = buildPath $ Context
libffiLibraryName :: Action FilePath
libffiLibraryName = do
useSystemFfi <- flag UseSystemFfi
windows <- windowsHost
return $ case (useSystemFfi, windows) of
return $ case (useSystemFfi, windowsHost) of
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
......
......@@ -107,7 +107,6 @@ bindistRules = do
targetPlatform <- setting TargetPlatformFull
distDir <- Context.distDir Stage1
rtsDir <- pkgIdentifier rts
windows <- windowsHost
let ghcBuildDir = root -/- stageString Stage1
bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty
......@@ -129,7 +128,7 @@ bindistRules = do
-- contain outdated or even invalid data.
whenM (doesDirectoryExist (root -/- "docs")) $ do
copyDirectory (root -/- "docs") bindistFilesDir
when windows $ do
when windowsHost $ do
copyDirectory (root -/- "mingw") bindistFilesDir
-- we use that opportunity to delete the .stamp file that we use
-- as a proxy for the whole mingw toolchain, there's no point in
......@@ -283,8 +282,7 @@ ghciScriptWrapper = unlines
-- explicitly and 'need' the result of building them.
needIservBins :: Action ()
needIservBins = do
windows <- windowsHost
when (not windows) $ do
when (not windowsHost) $ do
rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
need =<< traverse programPath
[ Context Stage1 iserv w
......
......@@ -27,7 +27,7 @@ configureRules = do
++ "automatically by passing the flag --configure."
else do
-- We cannot use windowsHost here due to a cyclic dependency.
when System.isWindows $ do
when windowsHost $ do
putBuild "| Checking for Windows tarballs..."
quietly $ cmd ["bash", "mk/get-win32-tarballs.sh", "download", System.arch]
let srcs = map (<.> "in") outs
......@@ -39,7 +39,7 @@ configureRules = do
-- We need to copy the directory with unpacked Windows tarball to
-- the build directory, so that the built GHC has access to it.
-- See https://github.com/snowleopard/hadrian/issues/564.
when System.isWindows $ do
when windowsHost $ do
root <- buildRoot
copyDirectory "inplace/mingw" (root -/- "mingw")
mingwFiles <- liftIO $ getDirectoryFilesIO "." [root -/- "mingw/**"]
......
......@@ -61,9 +61,8 @@ gmpRules = do
-- Copy appropriate GMP header and object files
gmpPath <- gmpBuildPathRules
gmpPath -/- gmpLibraryH %> \header -> do
windows <- windowsHost
configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
if not windows && -- TODO: We don't use system GMP on Windows. Fix?
if not windowsHost && -- TODO: We don't use system GMP on Windows. Fix?
any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
then do
putBuild "| GMP library/framework detected and will be used"
......
......@@ -84,15 +84,13 @@ libffiContext stage = do
-- | The name of the (locally built) library
libffiName :: Expr String
libffiName = do
windows <- expr windowsHost
way <- getWay
return $ libffiName' windows (Dynamic `wayUnit` way)
return $ libffiName' (Dynamic `wayUnit` way)
-- | The name of the (locally built) library
libffiName' :: Bool -> Bool -> String
libffiName' windows dynamic
= (if dynamic then "" else "C")
++ (if windows then "ffi-6" else "ffi")
libffiName' :: Bool -> String
libffiName' dynamic = (if dynamic then "" else "C")
++ (if windowsHost then "ffi-6" else "ffi")
libffiLibrary :: FilePath
libffiLibrary = "inst/lib/libffi.a"
......@@ -169,15 +167,13 @@ libffiRules = do
-- Find dynamic libraries.
dynLibFiles <- do
windows <- windowsHost
osx <- osxHost
let libfilesDir = libffiPath -/-
(if windows then "inst" -/- "bin" else "inst" -/- "lib")
libffiName'' = libffiName' windows True
(if windowsHost then "inst" -/- "bin" else "inst" -/- "lib")
libffiName'' = libffiName' True
dynlibext
| windows = "dll"
| osx = "dylib"
| otherwise = "so"
| windowsHost = "dll"
| osxHost = "dylib"
| otherwise = "so"
filepat = "lib" ++ libffiName'' ++ "." ++ dynlibext ++ "*"
liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat]
......
......@@ -137,12 +137,11 @@ buildConf _ context@Context {..} conf = do
-- to record this side effect so that Shake can cache these files too.
-- See why we need 'fixWindows': https://gitlab.haskell.org/ghc/ghc/issues/16073
let fixWindows path = do
win <- windowsHost
version <- setting GhcVersion
hostOs <- cabalOsString <$> setting BuildOs
hostArch <- cabalArchString <$> setting BuildArch
let dir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
return $ if win then path -/- "../.." -/- dir else path
return $ if windowsHost then path -/- "../.." -/- dir else path
pkgDbPath <- fixWindows =<< packageDbPath stage
let dir = pkgDbPath -/- takeBaseName conf
files <- liftIO $ getDirectoryFilesIO "." [dir -/- "**"]
......
......@@ -83,8 +83,7 @@ copyLibffiDynamicUnix stage libSuf target = do
copyFile' versionlessSourceFilePath target
-- On OSX the dylib's id must be updated to a relative path.
osx <- osxHost
when osx $ cmd
when osxHost $ cmd
[ "install_name_tool"
, "-id", "@rpath/" ++ takeFileName target
, target
......
......@@ -7,7 +7,6 @@ import Test.QuickCheck
import Base
import Context
import Oracles.ModuleFiles
import Oracles.Setting
import Packages
import Settings
import Target
......@@ -102,12 +101,11 @@ testModuleName = do
testPackages :: Action ()
testPackages = do
putBuild "==== Check system configuration"
win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.
putBuild "==== Packages, interpretInContext, configuration flags"
forM_ [Stage0 ..] $ \stage -> do
pkgs <- stagePackages stage
when (win32 `elem` pkgs) . test $ win
when (unix `elem` pkgs) . test $ not win
when (win32 `elem` pkgs) . test $ windowsHost
when (unix `elem` pkgs) . test $ not windowsHost
test $ pkgs == nubOrd pkgs
testWay :: Action ()
......
......@@ -135,8 +135,7 @@ testRules = do
timeoutProgBuilder :: Action ()
timeoutProgBuilder = do
root <- buildRoot
windows <- windowsHost
if windows
if windowsHost
then do
prog <- programPath =<< programContext Stage1 timeout
copyFile prog (root -/- timeoutPath)
......@@ -178,8 +177,7 @@ stageOf _ = error "unexpected stage argument"
needIservBins :: Action ()
needIservBins = do
-- iserv is not supported under Windows
windows <- windowsHost
when (not windows) $ do
when (not windowsHost) $ do
testGhc <- testCompiler <$> userSetting defaultTestArgs
let stg = stageOf testGhc
rtsways <- interpretInContext (vanillaContext stg ghc) getRtsWays
......
......@@ -16,8 +16,7 @@ cabalBuilderArgs = builder (Cabal Setup) ? do
pkg <- getPackage
path <- getContextPath
stage <- getStage
windows <- expr windowsHost
let prefix = "${pkgroot}" ++ (if windows then "" else "/..")
let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
mconcat [ arg "configure"
-- Don't strip libraries when cross compiling.
-- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
......
......@@ -53,7 +53,7 @@ cWarnings :: Args
cWarnings = mconcat
[ arg "-Wall"
, flag GccIsClang ? arg "-Wno-unknown-pragmas"
, notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
, notM (flag GccIsClang) ? not windowsHost ? arg "-Werror=unused-but-set-variable"
, notM (flag GccIsClang) ? arg "-Wno-error=inline" ]
packageDatabaseArgs :: Args
......
......@@ -61,7 +61,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
libs <- getContextData extraLibs
libDirs <- getContextData extraLibDirs
fmwks <- getContextData frameworks
darwin <- expr osxHost
way <- getWay
-- Relative path from the output (rpath $ORIGIN).
......@@ -87,7 +86,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
-- libraries will all end up in the lib dir, so just use $ORIGIN
| otherwise = metaOrigin
where
metaOrigin | darwin = "@loader_path"
metaOrigin | osxHost = "@loader_path"
| otherwise = "$ORIGIN"
-- TODO: an alternative would be to generalize by linking with extra
......@@ -117,7 +116,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
[ arg ("-optl-Wl,-rpath," ++ rpath)
, isProgram pkg ? arg ("-optl-Wl,-rpath," ++ bindistRpath)
-- The darwin linker doesn't support/require the -zorigin option
, not darwin ? arg "-optl-Wl,-zorigin"
, not osxHost ? arg "-optl-Wl,-zorigin"
]
]
, arg "-no-auto-link-packages"
......@@ -126,7 +125,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
, pure [ "-l" ++ lib | lib <- libs ]
, pure [ "-L" ++ libDir | libDir <- libDirs ]
, rtsFfiArg
, darwin ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ])
, osxHost ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ])
, debugged ? packageOneOf [ghc, iservProxy, iserv, remoteIserv] ?
arg "-debug"
......
......@@ -22,7 +22,7 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
tmpl <- (top -/-) <$> expr (templateHscPath Stage0)
mconcat [ arg $ "--cc=" ++ ccPath
, arg $ "--ld=" ++ ccPath
, notM windowsHost ? notM (flag CrossCompiling) ? arg "--cross-safe"
, not windowsHost ? notM (flag CrossCompiling) ? arg "--cross-safe"
, pure $ map ("-I" ++) (words gmpDir)
, map ("--cflag=" ++) <$> getCFlags
, map ("--lflag=" ++) <$> getLFlags
......
......@@ -76,8 +76,6 @@ runTestBuilderArgs = builder RunTest ? do
(,) <$> (maybe False (=="YES") <$> lookupEnv "PLATFORM")
<*> (maybe False (=="YES") <$> lookupEnv "OS")
windows <- expr windowsHost
darwin <- expr osxHost
threads <- shakeThreads <$> expr getShakeOptions
os <- getTestSetting TestHostOS
arch <- getTestSetting TestTargetARCH_CPP
......@@ -101,8 +99,8 @@ runTestBuilderArgs = builder RunTest ? do
-- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD
mconcat [ arg $ "testsuite/driver/runtests.py"
, pure [ "--rootdir=" ++ testdir | testdir <- rootdirs ]
, arg "-e", arg $ "windows=" ++ show windows
, arg "-e", arg $ "darwin=" ++ show darwin
, arg "-e", arg $ "windows=" ++ show windowsHost
, arg "-e", arg $ "darwin=" ++ show osxHost
, arg "-e", arg $ "config.local=False"
, arg "-e", arg $ "config.cleanup=" ++ show (not keepFiles)
, arg "-e", arg $ "config.accept=" ++ show accept
......
......@@ -22,7 +22,6 @@ import CommandLine
import Expression
import Flavour
import Oracles.Flag
import Oracles.Setting
import Packages
import Settings
import Settings.Builders.Alex
......@@ -54,7 +53,6 @@ defaultPackages Stage3 = return []
-- | Packages built in 'Stage0' by default. You can change this in "UserSettings".
stage0Packages :: Action [Package]
stage0Packages = do
win <- windowsHost
cross <- flag CrossCompiling
return $ [ binary
, cabal
......@@ -77,13 +75,12 @@ stage0Packages = do
, text
, transformers
, unlit ]
++ [ terminfo | not win, not cross ]
++ [ touchy | win ]
++ [ terminfo | not windowsHost, not cross ]
++ [ touchy | windowsHost ]
-- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
stage1Packages :: Action [Package]
stage1Packages = do
win <- windowsHost
intLib <- integerLibrary =<< flavour
libraries0 <- filter isLibrary <$> stage0Packages
cross <- flag CrossCompiling
......@@ -111,14 +108,14 @@ stage1Packages = do
, unlit
, xhtml
]
++ [ haddock | not cross ]
++ [ hpcBin | not cross ]
++ [ iserv | not win, not cross ]
++ [ libiserv | not win, not cross ]
++ [ runGhc | not cross ]
++ [ touchy | win ]
++ [ unix | not win ]
++ [ win32 | win ]
++ [ haddock | not cross ]
++ [ hpcBin | not cross ]
++ [ iserv | not windowsHost, not cross ]
++ [ libiserv | not windowsHost, not cross ]
++ [ runGhc | not cross ]
++ [ touchy | windowsHost ]
++ [ unix | not windowsHost ]
++ [ win32 | windowsHost ]
-- | Packages built in 'Stage2' by default. You can change this in "UserSettings".
stage2Packages :: Action [Package]
......@@ -127,7 +124,6 @@ stage2Packages = stage1Packages
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = do
win <- windowsHost
return $ [ checkApiAnnotations
, checkPpr
, ghci
......@@ -137,8 +133,8 @@ testsuitePackages = do
, hsc2hs
, iserv
, runGhc
, unlit ] ++
[ timeout | win ]
, unlit ] ++
[ timeout | windowsHost ]
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
......@@ -227,9 +223,8 @@ defaultFlavour = Flavour
-- in @mk/config.mk.in@.
defaultDynamicGhcPrograms :: Action Bool
defaultDynamicGhcPrograms = do
win <- windowsHost
supportsShared <- platformSupportsSharedLibs
return (not win && supportsShared)
return (not windowsHost && supportsShared)
-- | All 'Builder'-dependent command line arguments.
defaultBuilderArgs :: Args
......
......@@ -17,9 +17,11 @@ packageArgs = do
intLib <- getIntegerPackage
compilerPath <- expr $ buildPath (vanillaContext stage compiler)
gmpBuildPath <- expr gmpBuildPath
win <- expr windowsHost
cross <- expr (flag CrossCompiling)
let includeGmp = "-I" ++ gmpBuildPath -/- "include"
-- Do not bind the result to a Boolean: this forces the configure rule
-- immediately and may lead to cyclic dependencies.
-- See: https://gitlab.haskell.org/ghc/ghc/issues/16809.
cross = flag CrossCompiling
mconcat
--------------------------------- base ---------------------------------
......@@ -72,8 +74,8 @@ packageArgs = do
, builder (Cabal Flags) ? mconcat
[ ghcWithNativeCodeGen ? arg "ncg"
, ghcWithInterpreter ? notStage0 ? arg "ghci"
, notStage0 ? (not win && not cross) ? arg "ext-interp"
, flag CrossCompiling ? arg "-terminfo"
, notStage0 ? not windowsHost ? notM cross ? arg "ext-interp"
, cross ? arg "-terminfo"
, notStage0 ? intLib == integerGmp ?
arg "integer-gmp"
, notStage0 ? intLib == integerSimple ?
......@@ -87,8 +89,8 @@ packageArgs = do
, builder (Cabal Flags) ? mconcat
[ ghcWithInterpreter ? notStage0 ? arg "ghci"
, notStage0 ? (not win && not cross) ? arg "ext-interp"
, flag CrossCompiling ? arg "-terminfo"
, notStage0 ? not windowsHost ? notM cross ? arg "ext-interp"
, cross ? arg "-terminfo"
-- the 'threaded' flag is True by default, but
-- let's record explicitly that we link all ghc
-- executables with the threaded runtime.
......@@ -96,7 +98,7 @@ packageArgs = do
-------------------------------- ghcPkg --------------------------------
, package ghcPkg ?
builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo"
builder (Cabal Flags) ? cross ? arg "-terminfo"
-------------------------------- ghcPrim -------------------------------
, package ghcPrim ? mconcat
......@@ -121,9 +123,9 @@ packageArgs = do
-- behind the @-fghci@ flag.
, package ghci ? mconcat
[ notStage0 ? builder (Cabal Flags) ? arg "ghci"
, notStage0 ? builder (Cabal Flags) ? (not win && not cross)
, notStage0 ? builder (Cabal Flags) ? not windowsHost ? notM cross
? arg "ext-interp"
, flag CrossCompiling ? stage0 ? builder (Cabal Flags) ? arg "ghci" ]
, cross ? stage0 ? builder (Cabal Flags) ? arg "ghci" ]
-------------------------------- haddock -------------------------------
, package haddock ?
......@@ -131,7 +133,7 @@ packageArgs = do
------------------------------- haskeline ------------------------------
, package haskeline ?
builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo"
builder (Cabal Flags) ? cross ? arg "-terminfo"
-------------------------------- hsc2hs --------------------------------
, package hsc2hs ?
......
......@@ -2,7 +2,6 @@ module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where
import Expression
import Oracles.Flag
import Oracles.Setting
import Packages
import Settings
......@@ -13,7 +12,7 @@ defaultGhcWarningsArgs :: Args
defaultGhcWarningsArgs = mconcat
[ notStage0 ? arg "-Wnoncanonical-monad-instances"
, (not <$> flag GccIsClang) ? mconcat
[ (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable"
[ not windowsHost ? arg "-optc-Werror=unused-but-set-variable"
, arg "-optc-Wno-error=inline" ]
, flag GccIsClang ? arg "-optc-Wno-unknown-pragmas" ]
......
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