Magnus pushed to branch wip/mangoiv/ci-stages at Glasgow Haskell Compiler / GHC Commits: 8ff9044f by mangoiv at 2026-08-27T13:57:57+02:00 fixup! ci: build and test stage - - - - - 17 changed files: - hadrian/hie-bios.bat - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Package.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/hie-bios.bat ===================================== ===================================== hadrian/src/Base.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE MultiWayIf #-} module Base ( -- * General utilities @@ -22,6 +23,7 @@ module Base ( module Development.Shake.Util, Vec(..), (&%>), + exe, -- * Basic data types module Hadrian.Package, @@ -57,7 +59,7 @@ import Development.Shake hiding (unit, (&%>), (*>), Normal) #endif import qualified Development.Shake as Shake import Development.Shake.Classes -import Development.Shake.FilePath +import Development.Shake.FilePath hiding (exe) import Development.Shake.Util import Hadrian.Oracles.DirectoryContents import Hadrian.Utilities @@ -67,6 +69,13 @@ import GHC.Stack ( HasCallStack ) import Stage import Way +import GHC.Platform.ArchOS (ArchOS(..), Arch (..), OS (..)) + +exe :: ArchOS -> FilePath +exe arch + | ArchWasm32 <- archOS_arch arch = "wasm" + | OSMinGW32 <- archOS_OS arch = "exe" + | otherwise = "" -- | Hadrian lives in the 'hadrianPath' directory of the GHC tree. hadrianPath :: FilePath ===================================== hadrian/src/Builder.hs ===================================== @@ -15,7 +15,6 @@ import Control.Exception.Extra (Partial) import qualified Data.ByteString.Lazy.Char8 as BSL import Development.Shake.Classes import Development.Shake.Command -import Development.Shake.FilePath import GHC.Generics import GHC.Platform.ArchOS (ArchOS(..), Arch(..), OS(..)) import qualified Hadrian.Builder as H @@ -458,7 +457,7 @@ systemBuilderPath builder = case builder of -- Get program from a certain stage's target configuration fromStageTC stage keyname key = do - path <- prgPath . key <$> targetStage stage + path <- prgPath . key <$> perStageTarget stage validate keyname path validate keyname path = do @@ -479,7 +478,7 @@ systemBuilderPath builder = case builder of case (windowsHost, hasExtension fullPath) of (False, _ ) -> return path (True , True ) -> fixAbsolutePathOnWindows fullPath - (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe) + (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe (tgtArchOs target)) -- Without this function, on Windows we can observe a bad builder path -- for 'autoreconf'. If the relevant system.config field is set to ===================================== hadrian/src/Context.hs ===================================== @@ -51,7 +51,7 @@ getWay = way <$> getContext -- | Get the 'Target' configuration of the current stage getStagedTarget :: Expr Context b Target -getStagedTarget = expr . targetStage =<< getStage +getStagedTarget = expr . perStageTarget =<< getStage -- | Path to the directory containing the final artifact in a given 'Context'. libPath :: Context -> Action FilePath ===================================== hadrian/src/Flavour.hs ===================================== @@ -170,7 +170,7 @@ werror = addArgs $ do -- TODO: get rid of EFF_ altogether (#14647) and make sure -- unregisterised backend emits clean C without needing -- these hacks. - , queryTargetTarget stage tgtUnregisterised ? arg "-optc-Wno-error" + , queryPerStageTargetSpec stage tgtUnregisterised ? arg "-optc-Wno-error" ] -- N.B. We currently don't build the boot libraries' C sources with -Werror -- as this tends to be a portability nightmare. ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -125,7 +125,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey (stag, pkg)) -> do flav <- flavour let flavourArgs = extraArgs flav - targetOs <- queryTargetTarget stag queryOS + targetOs <- queryPerStageTargetSpec stag queryOS projectVersion <- setting ProjectVersion let pkgHashCompilerId = "ghc-" ++ projectVersion pkgHashPlatform = targetOs ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -23,7 +23,7 @@ module Hadrian.Package ( ) where import Development.Shake.Classes -import Development.Shake.FilePath +import Development.Shake.FilePath ((<.>)) import GHC.Generics import Hadrian.Utilities ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -77,13 +77,13 @@ getFlag = expr . flag targetRTSLinkerOnlySupportsSharedLibs :: Stage -> Action Bool targetRTSLinkerOnlySupportsSharedLibs s = - queryTargetTarget s Toolchain.tgtRTSLinkerOnlySupportsSharedLibs + queryPerStageTargetSpec s Toolchain.tgtRTSLinkerOnlySupportsSharedLibs arSupportsDashL :: Stage -> Action Bool -arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage +arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> perStageTarget stage arSupportsAtFile :: Stage -> Action Bool -arSupportsAtFile stage = Toolchain.arSupportsAtFile . tgtAr <$> targetStage stage +arSupportsAtFile stage = Toolchain.arSupportsAtFile . tgtAr <$> perStageTarget stage targetSupportsSharedLibs :: Stage -> Action Bool targetSupportsSharedLibs stage = do @@ -101,10 +101,10 @@ targetSupportsThreadedRts stage = do -- | Does the target support the -N RTS flag? targetSupportsSMP :: Stage -> Action Bool -targetSupportsSMP stage = queryTargetTarget stage Toolchain.tgtSupportsSMP +targetSupportsSMP stage = queryPerStageTargetSpec stage Toolchain.tgtSupportsSMP targetUseLibffiForAdjustors :: Stage -> Action Bool -targetUseLibffiForAdjustors stage = queryTargetTarget stage tgtUseLibffiForAdjustors +targetUseLibffiForAdjustors stage = queryPerStageTargetSpec stage tgtUseLibffiForAdjustors useLibdw :: Stage -> Action Bool -useLibdw stage = queryTargetTarget stage (isJust . tgtRTSWithLibdw) +useLibdw stage = queryPerStageTargetSpec stage (isJust . tgtRTSWithLibdw) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -6,7 +6,7 @@ module Oracles.Setting ( -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, - libsuf, ghcVersionStage, bashPath, targetStage, crossStage, queryTarget, queryTargetTarget, + libsuf, ghcVersionStage, bashPath, perStageTarget, crossStage, queryTarget, queryPerStageTargetSpec, isHostStage, -- ** Target platform things @@ -153,7 +153,7 @@ isOsxTarget :: Stage -> Action Bool isOsxTarget stage = anyTargetOs stage [OSDarwin] isArmTarget :: Stage -> Action Bool -isArmTarget stage = queryTargetTarget stage (isARM . archOS_arch . tgtArchOs) +isArmTarget stage = queryPerStageTargetSpec stage (isARM . archOS_arch . tgtArchOs) -- | Check whether the host OS setting matches one of the given strings. anyHostOs :: [OS] -> Action Bool @@ -162,15 +162,15 @@ anyHostOs oss = (`elem` oss) <$> queryHostTarget (archOS_OS . tgtArchOs) -- | Check whether the target architecture setting matches one of the given -- strings. anyTargetArch :: Stage -> [Arch] -> Action Bool -anyTargetArch stage archs = (`elem` archs) <$> queryTargetTarget stage (archOS_arch . tgtArchOs) +anyTargetArch stage archs = (`elem` archs) <$> queryPerStageTargetSpec stage (archOS_arch . tgtArchOs) -- | Check whether the target OS setting matches one of the given strings. anyTargetOs :: Stage -> [OS] -> Action Bool -anyTargetOs stage oss = (`elem` oss) <$> queryTargetTarget stage (archOS_OS . tgtArchOs) +anyTargetOs stage oss = (`elem` oss) <$> queryPerStageTargetSpec stage (archOS_OS . tgtArchOs) -- | Check whether the target OS uses the ELF object format. isElfTarget :: Stage -> Action Bool -isElfTarget stage = queryTargetTarget stage (osElfTarget . archOS_OS . tgtArchOs) +isElfTarget stage = queryPerStageTargetSpec stage (osElfTarget . archOS_OS . tgtArchOs) -- | Check whether the target OS supports the @-rpath@ linker option when -- using dynamic linking. @@ -180,7 +180,7 @@ isElfTarget stage = queryTargetTarget stage (osElfTarget . archOS_OS . tgtArchOs -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). targetSupportsRPaths :: Stage -> Action Bool -targetSupportsRPaths stage = queryTargetTarget stage +targetSupportsRPaths stage = queryPerStageTargetSpec stage (\t -> let os = archOS_OS (tgtArchOs t) in osElfTarget os || osMachOTarget os) @@ -188,7 +188,7 @@ targetSupportsRPaths stage = queryTargetTarget stage -- ARM)? targetArmVersion :: Stage -> Action (Maybe ArmISA) targetArmVersion stage = runMaybeT $ do - ArchARM isa _ _ <- lift $ queryTargetTarget stage (archOS_arch . tgtArchOs) + ArchARM isa _ _ <- lift $ queryPerStageTargetSpec stage (archOS_arch . tgtArchOs) return isa -- | Canonicalised GHC version number, used for integer version comparisons. We @@ -231,33 +231,34 @@ libsuf st way let suffix = waySuffix (removeWayUnit Dynamic way) return (suffix ++ "-ghc" ++ version ++ extension) --- | Build libraries for this `Stage` targetting this `Target` +-- | Determine the 'Target' that this 'Stage' is supposed to build libraries for. -- --- For example, we want to build RTS with stage1 for the host target as we +-- For example, we want to build RTS with stage1 for the host as we -- produce a host executable with stage1 (which cross-compiles to stage2). -targetStage :: Stage -> Action Target -targetStage Stage0 {} = getHostTarget -targetStage stage | isHostStage stage = do +perStageTarget :: Stage -> Action Target +perStageTarget Stage0 {} = getHostTarget +perStageTarget stage | isHostStage stage = do ht <- getHostTarget tt <- getTargetTarget if targetPlatformTriple ht == targetPlatformTriple tt then return tt else return ht -targetStage _ = getTargetTarget +perStageTarget _ = getTargetTarget isHostStage :: Stage -> Bool isHostStage stage | stage <= Stage1 = True isHostStage _ = False -queryTarget :: Stage -> (Target -> a) -> (Expr c b a) -queryTarget s f = expr (f <$> targetStage s) +queryTarget :: Stage -> (Target -> a) -> Expr c b a +queryTarget s f = expr (f <$> perStageTarget s) -queryTargetTarget :: Stage -> (Target -> a) -> Action a -queryTargetTarget s f = f <$> targetStage s +-- | get the conentents of the .target file for the specified stage +queryPerStageTargetSpec :: Stage -> (Target -> a) -> Action a +queryPerStageTargetSpec s f = f <$> perStageTarget s -- | A 'Stage' is a cross-stage if the produced compiler is a cross-compiler. crossStage :: Stage -> Action Bool crossStage st = do - st_target <- targetStage (succStage st) - st_host <- targetStage st + st_target <- perStageTarget (succStage st) + st_host <- perStageTarget st return (targetPlatformTriple st_target /= targetPlatformTriple st_host) ===================================== hadrian/src/Oracles/TestSettings.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Setting (topDirectory, setting, ProjectSetting(..), crossStage) import Packages import Settings.Program (programContext) import Hadrian.Oracles.Path +import GHC.Toolchain (Target(tgtArchOs)) testConfigFile :: Action FilePath testConfigFile = buildRoot <&> (-/- "test/ghcconfig") @@ -154,10 +155,11 @@ getTestExePath testGhc pkg = do bindir <- getBinaryDirectory testGhc compiler_path <- getCompilerPath testGhc cross <- getBooleanSetting TestCrossCompiling + tgt <- getTargetTarget -- FIXME: is this right -- ask rodrigo about the targettarget and query/get versions of this function let cross_prefix = if cross then dropWhileEnd ((/=) '-') (takeFileName compiler_path) else "" -- get relative path for the given program in the given stage let make_absolute rel_path = do abs_path <- liftIO (makeAbsolute rel_path) fixAbsolutePathOnWindows abs_path - make_absolute (bindir </> (cross_prefix ++ programBasename pkg) <.> exe) + make_absolute (bindir </> (cross_prefix ++ programBasename pkg) <.> exe (tgtArchOs tgt)) -- get relative path for the given program in the given stage ===================================== hadrian/src/Packages.hs ===================================== @@ -24,6 +24,8 @@ import Hadrian.Utilities import Base import Context.Type import Oracles.Setting +import GHC.Toolchain (tgtArchOs) +import qualified Development.Shake.FilePath as Shake -- | These are all GHC packages we know about. Build rules will be generated for -- all of them. However, not all of these packages will be built. For example, @@ -196,12 +198,13 @@ programPath :: Context -> Action FilePath programPath context@Context {..} = do name <- programName context path <- stageBinPath stage - return $ path -/- name <.> exe + arch <- queryPerStageTargetSpec stage tgtArchOs + return $ path -/- name <.> exe arch -- TODO: Move @timeout@ to the @util@ directory and build in a more standard -- location like other programs used only by the testsuite. timeoutPath :: FilePath -timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe +timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> Shake.exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -276,7 +276,7 @@ generateRules = do else prefix relPkgDb = makeRelativeNoSysLink libTopDir pkgDb go (generateSettings out True relPkgDb) out - (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out + (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (perStageTarget (succStage stage))) out where file <~+ gen = file %> \out -> generate out emptyTarget gen >> makeExecutable out @@ -447,7 +447,7 @@ bindistRules = do , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . targetStage) + , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . perStageTarget) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2 @@ -536,7 +536,7 @@ generateConfigHs :: Expr String generateConfigHs = do stage <- getStage let chooseSetting x y = case stage of { Stage0 {} -> x; _ -> y } - let queryTarget f = f <$> expr (targetStage stage) + let queryTarget f = f <$> expr (perStageTarget stage) -- Not right for stage3 buildPlatform <- chooseSetting (queryBuild targetPlatformTriple) (queryHost targetPlatformTriple) hostPlatform <- queryTarget targetPlatformTriple ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -9,7 +9,7 @@ import Base import Context import Expression hiding (stage, way) import Oracles.ModuleFiles -import Oracles.Setting (topDirectory) +import Oracles.Setting (topDirectory, perStageTarget) import Packages import Settings import Settings.Default @@ -18,6 +18,7 @@ import Target import Utilities import Rules.Library import Rules.Register +import GHC.Toolchain (Target(tgtArchOs)) -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () @@ -49,13 +50,14 @@ getProgramContexts stage = do -- 'Rules', because it is an 'Action' depending on an oracle. sPackages <- filter isProgram <$> stagePackages stage tPackages <- testsuitePackages + tgt <- perStageTarget stage -- TODO: Shall we use Stage2 for testsuite packages instead? let allPackages = sPackages ++ tPackages forM allPackages $ \pkg -> do ctx <- programContext stage pkg -- TODO: see todo on programContext. name <- programName ctx - return (name <.> exe, ctx) + return (name <.> exe (tgtArchOs tgt), ctx) lookupProgramContext :: FilePath -> [(FilePath, Context)] -> Maybe Context lookupProgramContext wholePath progs = lookup (takeFileName wholePath) progs ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module Rules.Test (testRules) where @@ -22,58 +23,70 @@ import GHC.Toolchain as Toolchain import GHC.Toolchain.Program as Toolchain import Hadrian.Oracles.Path import Hadrian.Oracles.TextFile (getHostTarget, getTargetTarget) +import GHC.Platform.ArchOS (ArchOS (..), Arch (..), OS (..)) -checkPprProgPath, checkPprSourcePath :: FilePath -checkPprProgPath = "test/bin/check-ppr" <.> exe +checkPprProgPath :: ArchOS -> FilePath +checkPprProgPath archos = "test/bin/check-ppr" <.> exe archos +checkPprSourcePath :: FilePath checkPprSourcePath = "utils/check-ppr/Main.hs" checkPprExtra :: [String] checkPprExtra = [] -checkExactProgPath, checkExactSourcePath :: FilePath -checkExactProgPath = "test/bin/check-exact" <.> exe +checkExactProgPath :: ArchOS -> FilePath +checkExactProgPath archos = "test/bin/check-exact" <.> exe archos +checkExactSourcePath :: FilePath checkExactSourcePath = "utils/check-exact/Main.hs" checkExactExtra :: [String] checkExactExtra = ["-iutils/check-exact"] -countDepsProgPath, countDepsSourcePath :: FilePath -countDepsProgPath = "test/bin/count-deps" <.> exe +countDepsProgPath :: ArchOS -> FilePath +countDepsProgPath archos = "test/bin/count-deps" <.> exe archos +countDepsSourcePath :: FilePath countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] -dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath -dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsProgPath :: ArchOS -> FilePath +dumpDeclsProgPath archos = "test/bin/dump-decls" <.> exe archos +dumpDeclsSourcePath :: FilePath dumpDeclsSourcePath = "utils/dump-decls/Main.hs" dumpDeclsExtra :: [String] dumpDeclsExtra = [] -noteLinterProgPath, noteLinterSourcePath :: FilePath -noteLinterProgPath = "test/bin/lint-notes" <.> exe +noteLinterProgPath :: ArchOS -> FilePath +noteLinterProgPath archos = "test/bin/lint-notes" <.> exe archos +noteLinterSourcePath :: FilePath noteLinterSourcePath = "linters/lint-notes/Main.hs" noteLinterExtra :: [String] noteLinterExtra = ["-ilinters/lint-notes"] -codeLinterProgPath, codeLinterSourcePath :: FilePath -codeLinterProgPath = "test/bin/lint-codes" <.> exe +codeLinterProgPath :: ArchOS -> FilePath +codeLinterProgPath archos = "test/bin/lint-codes" <.> exe archos +codeLinterSourcePath :: FilePath codeLinterSourcePath = "linters/lint-codes/Main.hs" codeLinterExtra :: [String] codeLinterExtra = ["-ilinters/lint-codes"] -whitespaceLinterProgPath, whitespaceLinterSourcePath :: FilePath -whitespaceLinterProgPath = "test/bin/lint-whitespace" <.> exe +whitespaceLinterProgPath :: ArchOS -> FilePath +whitespaceLinterProgPath archos = "test/bin/lint-whitespace" <.> exe archos +whitespaceLinterSourcePath :: FilePath whitespaceLinterSourcePath = "linters/lint-whitespace/Main.hs" whitespaceLinterExtra :: [String] whitespaceLinterExtra = ["-ilinters/lint-whitespace", "-ilinters/linters-common"] -changelogDProgPath, changelogDSourcePath :: FilePath -changelogDProgPath = "test/bin/changelog-d" <.> exe +changelogDProgPath :: ArchOS -> FilePath +changelogDProgPath archos = "test/bin/changelog-d" <.> exe archos +changelogDSourcePath :: FilePath changelogDSourcePath = "utils/changelog-d/ChangelogD.hs" changelogDExtra :: [String] changelogDExtra = ["-iutils/changelog-d"] data CheckProgram = CheckProgram { cp_target :: String -- ^ Name for the hadrian target - , cp_exe_path :: FilePath -- ^ Path to resulting executable + , cp_exe_path :: ArchOS -> FilePattern + -- ^ Path to resulting executable. + -- This depends on the taret the program is built for, + -- not the host that hadrian is built on , cp_src_path :: FilePath -- ^ Source to the Main.hs for the executable , cp_extra_args :: [String] -- ^ Any extra arguments to use when compiling Main.hs , cp_hadrian_pkg :: Package -- ^ How to build the executable when using in-tree compiler. @@ -83,16 +96,16 @@ data CheckProgram = checkPrograms :: [CheckProgram] checkPrograms = - [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id - , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id - , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id - , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id - , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id - , CheckProgram "lint:codes" codeLinterProgPath codeLinterSourcePath codeLinterExtra lintCodes id id - , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) + [ CheckProgram { cp_target = "test:check-ppr", cp_exe_path = checkPprProgPath, cp_src_path = checkPprSourcePath, cp_extra_args = checkPprExtra, cp_hadrian_pkg = checkPpr, cp_modify_stage = id, cp_modify_deps = id } + , CheckProgram { cp_target = "test:check-exact", cp_exe_path = checkExactProgPath, cp_src_path = checkExactSourcePath, cp_extra_args = checkExactExtra, cp_hadrian_pkg = checkExact, cp_modify_stage = id, cp_modify_deps = id } + , CheckProgram { cp_target = "test:count-deps", cp_exe_path = countDepsProgPath, cp_src_path = countDepsSourcePath, cp_extra_args = countDepsExtra, cp_hadrian_pkg = countDeps, cp_modify_stage = id, cp_modify_deps = id } + , CheckProgram { cp_target = "test:dump-decls", cp_exe_path = dumpDeclsProgPath, cp_src_path = dumpDeclsSourcePath, cp_extra_args = dumpDeclsExtra, cp_hadrian_pkg = dumpDecls, cp_modify_stage = id, cp_modify_deps = id } + , CheckProgram { cp_target = "lint:notes", cp_exe_path = noteLinterProgPath, cp_src_path = noteLinterSourcePath, cp_extra_args = noteLinterExtra, cp_hadrian_pkg = lintNotes, cp_modify_stage = (const stage0Boot), cp_modify_deps = id } + , CheckProgram { cp_target = "lint:codes", cp_exe_path = codeLinterProgPath, cp_src_path = codeLinterSourcePath, cp_extra_args = codeLinterExtra, cp_hadrian_pkg = lintCodes, cp_modify_stage = id, cp_modify_deps = id } + , CheckProgram { cp_target = "lint:whitespace", cp_exe_path = whitespaceLinterProgPath, cp_src_path = whitespaceLinterSourcePath, cp_extra_args = whitespaceLinterExtra, cp_hadrian_pkg = lintWhitespace, cp_modify_stage = (const stage0Boot), cp_modify_deps = (filter (/= lintersCommon)) } -- N.B. The lint:changelog build is replicated by lint_changelog in -- .gitlab/ci.sh. Keep its package dependencies in sync with this target. - , CheckProgram "lint:changelog" changelogDProgPath changelogDSourcePath changelogDExtra changelogD (const stage0Boot) id + , CheckProgram { cp_target = "lint:changelog", cp_exe_path = changelogDProgPath, cp_src_path = changelogDSourcePath, cp_extra_args = changelogDExtra, cp_hadrian_pkg = changelogD, cp_modify_stage = (const stage0Boot), cp_modify_deps = id } ] inTreeOutTree :: (Stage -> Action b) -> Action b -> Action b @@ -136,12 +149,23 @@ testRules = do testsuiteDeps + -- the test targets will all be compiled by the test comppiler which is going + -- to produce artifacts for its target + -- Rules for building check-ppr, check-exact and -- check-ppr-annotations with the compiler we are going to test -- (in-tree or out-of-tree). - forM_ checkPrograms $ \(CheckProgram name progPath sourcePath mextra progPkg mod_stage mod_pkgs) -> do - name ~> need [root -/- progPath] - root -/- progPath %> \path -> do + forM_ checkPrograms $ \(CheckProgram name progPathForArch sourcePath mextra progPkg mod_stage mod_pkgs) -> do + name ~> do + tt <- getTargetTarget + need [root -/- progPathForArch (tgtArchOs tt)] + + -- HACK: we don't havea program path here and just a pattern + -- because we can't query the target before declaring the rule. + -- we specify target arch linux (no extension), then append a pattern + -- for any extension + let filePat = progPathForArch ArchOS { archOS_arch = ArchUnknown, archOS_OS = OSLinux } <> "*" + root -/- filePat %> \path -> do need [ sourcePath ] testGhc <- testCompiler <$> userSetting defaultTestArgs @@ -167,7 +191,7 @@ testRules = do | targetPlatformTriple ht /= targetPlatformTriple tt = targetPlatform ++ "-" ++ prog | otherwise = prog let dynPrograms = hasDynamic test_args - cmd [bindir </> mkGhcProg "ghc" <.> exe] $ -- FIXME: needs proper prefix! + cmd [bindir </> mkGhcProg "ghc" <.> exe (tgtArchOs ht)] $ concatMap (\p -> ["-package", pkgName p]) depsPkgs ++ ["-o", top -/- path, top -/- sourcePath] ++ mextra ++ @@ -243,8 +267,12 @@ testEnv stg = do top <- topDirectory pythonPath <- builderPath Python -- MP: TODO wrong, should use the ccPath and ccFlags from the bindist we are testing. - ccPath <- queryTargetTarget stg (Toolchain.prgPath . Toolchain.ccProgram . Toolchain.tgtCCompiler) - ccFlags <- queryTargetTarget stg (unwords . Toolchain.prgFlags . Toolchain.ccProgram . Toolchain.tgtCCompiler) + tgt <- queryPerStageTargetSpec stg id + let ccPath = tgt.tgtCCompiler.ccProgram.prgPath + let ccFlags = unwords tgt.tgtCCompiler.ccProgram.prgFlags + let archos = tgt.tgtArchOs + let mkProgPath k = top -/- root -/- k archos + ghcFlags <- runTestGhcFlags stg let ghciFlags = ghcFlags ++ unwords [ "--interactive", "-v0", "-ignore-dot-ghci" @@ -262,14 +290,14 @@ testEnv stg = do , "TEST_HC_OPTS_INTERACTIVE" .= ghciFlags , "TEST_CC" .= ccPath , "TEST_CC_OPTS" .= ccFlags - , "CHECK_PPR" .= (top -/- root -/- checkPprProgPath) - , "CHECK_EXACT" .= (top -/- root -/- checkExactProgPath) - , "DUMP_DECLS" .= (top -/- root -/- dumpDeclsProgPath) - , "COUNT_DEPS" .= (top -/- root -/- countDepsProgPath) - , "LINT_NOTES" .= (top -/- root -/- noteLinterProgPath) - , "LINT_CODES" .= (top -/- root -/- codeLinterProgPath) - , "LINT_WHITESPACE" .= (top -/- root -/- whitespaceLinterProgPath) - , "CHANGELOG_D" .= (top -/- root -/- changelogDProgPath) + , "CHECK_PPR" .= mkProgPath checkPprProgPath + , "CHECK_EXACT" .= mkProgPath checkExactProgPath + , "DUMP_DECLS" .= mkProgPath dumpDeclsProgPath + , "COUNT_DEPS" .= mkProgPath countDepsProgPath + , "LINT_NOTES" .= mkProgPath noteLinterProgPath + , "LINT_CODES" .= mkProgPath codeLinterProgPath + , "LINTstageWHITESPACE" .= mkProgPath whitespaceLinterProgPath + , "CHANGELOG_D" .= mkProgPath changelogDProgPath -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk -- which is in turn included by all test 'Makefile's. ===================================== hadrian/src/Settings/Builders/DeriveConstants.hs ===================================== @@ -42,8 +42,8 @@ includeCcArgs = do stage <- getStage rtsPath <- expr $ rtsBuildPath stage mconcat [ cWarnings - , prgFlags . ccProgram . tgtCCompiler <$> expr (targetStage stage) - , queryTargetTarget stage tgtUnregisterised ? arg "-DUSE_MINIINTERPRETER" + , prgFlags . ccProgram . tgtCCompiler <$> expr (perStageTarget stage) + , queryPerStageTargetSpec stage tgtUnregisterised ? arg "-DUSE_MINIINTERPRETER" , arg "-Irts" , arg "-Irts/include" , arg $ "-I" ++ rtsPath </> "include" ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedFieldPuns #-} module Settings.Builders.RunTest (runTestBuilderArgs , runTestGhcFlags , assertSameCompilerArgs @@ -27,7 +28,7 @@ import GHC.Toolchain.Target -- | Extra flags to send to the Haskell compiler to run tests. runTestGhcFlags :: Stage -> Action String runTestGhcFlags stage = do - unregisterised <- queryTargetTarget stage tgtUnregisterised + unregisterised <- queryPerStageTargetSpec stage tgtUnregisterised let ifMinGhcVer ver opt = do v <- ghcCanonVersion if ver <= v then pure opt @@ -112,10 +113,10 @@ inTreeCompilerArgs stg = do ways <- interpretInContext (vanillaContext ghcStage rts) getRtsWays return (dynamic `elem` ways, threaded `elem` ways) hasDynamic <- (wayUnit Dynamic) . Context.Type.way <$> (programContext stg ghc) - leadingUnderscore <- queryTargetTarget ghcStage tgtSymbolsHaveLeadingUnderscore + leadingUnderscore <- queryPerStageTargetSpec ghcStage tgtSymbolsHaveLeadingUnderscore withInterpreter <- ghcWithInterpreter ghcStage - unregisterised <- queryTargetTarget ghcStage tgtUnregisterised - tables_next_to_code <- queryTargetTarget ghcStage tgtTablesNextToCode + unregisterised <- queryPerStageTargetSpec ghcStage tgtUnregisterised + tables_next_to_code <- queryPerStageTargetSpec ghcStage tgtTablesNextToCode targetWithSMP <- targetSupportsSMP ghcStage interpForceDyn <- targetRTSLinkerOnlySupportsSharedLibs ghcStage @@ -124,17 +125,17 @@ inTreeCompilerArgs stg = do profiled <- ghcProfiled <$> flavour <*> pure ghcStage os <- queryHostTarget queryOS - arch <- queryTargetTarget ghcStage queryArch + arch <- queryPerStageTargetSpec ghcStage queryArch let codegen_arches = ["x86_64", "i386", "powerpc", "powerpc64", "powerpc64le", "aarch64", "wasm32", "riscv64", "loongarch64"] let withNativeCodeGen | unregisterised = False | arch `elem` codegen_arches = True | otherwise = False - platform <- queryTargetTarget ghcStage targetPlatformTriple - wordsize <- show @Int . (*8) <$> queryTargetTarget ghcStage (wordSize2Bytes . tgtWordSize) + platform <- queryPerStageTargetSpec ghcStage targetPlatformTriple + wordsize <- show @Int . (*8) <$> queryPerStageTargetSpec ghcStage (wordSize2Bytes . tgtWordSize) - llc_cmd <- queryTargetTarget ghcStage tgtLlc - llvm_as_cmd <- queryTargetTarget ghcStage tgtLlvmAs + llc_cmd <- queryPerStageTargetSpec ghcStage tgtLlc + llvm_as_cmd <- queryPerStageTargetSpec ghcStage tgtLlvmAs let have_llvm = allowHaveLLVM arch && all isJust [llc_cmd, llvm_as_cmd] top <- topDirectory @@ -231,6 +232,8 @@ runTestBuilderArgs = builder Testsuite ? do keepFiles <- expr (testKeepFiles <$> userSetting defaultTestArgs) + tgtArchOs <- expr $ queryPerStageTargetSpec stage tgtArchOs + accept <- expr (testAccept <$> userSetting defaultTestArgs) (acceptPlatform, acceptOS) <- expr . liftIO $ (,) <$> (maybe False (=="YES") <$> lookupEnv "PLATFORM") @@ -266,7 +269,7 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "config.accept=" ++ show accept , arg "-e", arg $ "config.accept_platform=" ++ show acceptPlatform , arg "-e", arg $ "config.accept_os=" ++ show acceptOS - , arg "-e", arg $ "config.exeext=" ++ quote (if null exe then "" else "."<>exe) + , arg "-e", arg $ "config.exeext=" ++ quote ("" <.> exe tgtArchOs) , arg "-e", arg $ "config.compiler_debugged=" ++ show debugAssertions , arg "-e", arg $ "config.debug_rts=" ++ show debugged ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -295,8 +295,8 @@ rtsPackageArgs = package rts ? do path <- getBuildPath top <- expr topDirectory useSystemFfi <- succStaged (buildFlag UseSystemFfi) - libdwIncludeDir <- staged (\s -> queryTargetTarget s (Lib.includePath <=< tgtRTSWithLibdw)) - libdwLibraryDir <- staged (\s -> queryTargetTarget s (Lib.libraryPath <=< tgtRTSWithLibdw)) + libdwIncludeDir <- staged (\s -> queryPerStageTargetSpec s (Lib.includePath <=< tgtRTSWithLibdw)) + libdwLibraryDir <- staged (\s -> queryPerStageTargetSpec s (Lib.libraryPath <=< tgtRTSWithLibdw)) libnumaIncludeDir <- staged (buildSetting LibnumaIncludeDir) libnumaLibraryDir <- staged (buildSetting LibnumaLibDir) libzstdIncludeDir <- staged (buildSetting LibZstdIncludeDir) @@ -412,7 +412,7 @@ rtsPackageArgs = package rts ? do , buildFlag UseLibnuma stage `cabalFlag` "libnuma" , buildFlag UseLibzstd stage `cabalFlag` "libzstd" , buildFlag StaticLibzstd stage `cabalFlag` "static-libzstd" - , queryTargetTarget stage tgtSymbolsHaveLeadingUnderscore `cabalFlag` "leading-underscore" + , queryPerStageTargetSpec stage tgtSymbolsHaveLeadingUnderscore `cabalFlag` "leading-underscore" , ghcUnreg `cabalFlag` "unregisterised" , ghcEnableTNC `cabalFlag` "tables-next-to-code" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ff9044fd3fbdc621eceb7dfa7153b27... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ff9044fd3fbdc621eceb7dfa7153b27... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help