hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix cross target being ignored

Browse Source
This commit is contained in:
Julian Ospald 2023-07-04 16:06:03 +02:00
parent 3218aaa378
commit 4361ef7a72
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
2 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/ghcup/GHCup/OptParse/Compile.hs
View File

@ -66,7 +66,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: GHC.GHCVer Version { targetGhc :: GHC.GHCVer
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe FilePath , buildConfig :: Maybe FilePath
@ -568,10 +568,8 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure () _ -> pure ()
targetVer <- liftE $ compileGHC targetVer <- liftE $ compileGHC
((\case targetGhc
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v crossTarget
GHC.GitDist g -> GHC.GitDist g
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
ovewrwiteVer ovewrwiteVer
bootstrapGhc bootstrapGhc
jobs jobs

35
lib/GHCup/GHC.hs
View File

@ -80,9 +80,9 @@ import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
data GHCVer v = SourceDist v data GHCVer = SourceDist Version
| GitDist GitBranch | GitDist GitBranch
| RemoteDist URI | RemoteDist URI
@ -755,7 +755,8 @@ compileGHC :: ( MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> GHCVer GHCTargetVersion => GHCVer
-> Maybe Text -- ^ cross target
-> Maybe Version -- ^ overwrite version -> Maybe Version -- ^ overwrite version
-> Either Version FilePath -- ^ version to bootstrap with -> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
@ -792,19 +793,19 @@ compileGHC :: ( MonadMask m
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(workdir, tmpUnpack, tver) <- case targetGhc of (workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball -- unpack from version tarball
SourceDist tver -> do SourceDist ver -> do
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball -- download source tarball
dlInfo <- dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls preview (ix GHC % ix ver % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing
@ -818,7 +819,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
(view dlSubdir dlInfo) (view dlSubdir dlInfo)
liftE $ applyAnyPatch patches (fromGHCupPath workdir) liftE $ applyAnyPatch patches (fromGHCupPath workdir)
pure (workdir, tmpUnpack, Just tver) pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
RemoteDist uri -> do RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri) lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@ -842,7 +843,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf) let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
pure (workdir, tmpUnpack, mkTVer <$> tver) pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- clone from git -- clone from git
GitDist GitBranch{..} -> do GitDist GitBranch{..} -> do
@ -899,10 +900,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
pure tver pure tver
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver) pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- the version that's installed may differ from the -- the version that's installed may differ from the
-- compiled version, so the user can overwrite it -- compiled version, so the user can overwrite it
installVer <- if | Just ov' <- ov -> pure (mkTVer ov') installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
| Just tver' <- tver -> pure tver' | Just tver' <- tver -> pure tver'
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322" | otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
@ -987,9 +988,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
defaultConf = defaultConf =
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross"))) let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default"))) default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
in case targetGhc of in case crossTarget of
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk Just _ -> cross_mk
_ -> default_mk _ -> default_mk
compileHadrianBindist :: ( MonadReader env m compileHadrianBindist :: ( MonadReader env m
, HasDirs env , HasDirs env
@ -1162,8 +1163,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let lines' = fmap T.strip . T.lines $ decUTF8Safe c let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only -- for cross, we need Stage1Only
case targetGhc of case crossTarget of
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
(InvalidBuildConfig (InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
) )