[Git][ghc/ghc][wip/hadrian-cross-stage2] 4 commits: WIP: Run testsuite from bindist for cross
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Oct 4 11:37:42 UTC 2023
Matthew Pickering pushed to branch wip/hadrian-cross-stage2 at Glasgow Haskell Compiler / GHC
Commits:
501133f0 by GHC GitLab CI at 2023-10-03T16:18:53+00:00
WIP: Run testsuite from bindist for cross
- - - - -
7d2b974b by Matthew Pickering at 2023-10-04T09:12:45+00:00
Correctly compute cross-prefix
- - - - -
74ff483e by Matthew Pickering at 2023-10-04T09:58:17+00:00
Move predicates to --info rather than +RTS --info
- - - - -
c932319c by GHC GitLab CI at 2023-10-04T11:36:04+00:00
WIP
- - - - -
12 changed files:
- .gitlab/ci.sh
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- testsuite/driver/testlib.py
- testsuite/ghc-config/ghc-config.hs
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -490,7 +490,8 @@ function build_hadrian() {
export XZ_OPT="${XZ_OPT:-} -T$cores"
fi
- case "${CROSS_STAGE:2}" in
+ echo "CROSS_STAGE: $CROSS_STAGE"
+ case "${CROSS_STAGE:-2}" in
2) BINDIST_TARGET="binary-dist";;
3) BINDIST_TARGET="binary-dist-stage3";;
*) fail "Unknown CROSS_STAGE, must be 2 or 3";;
@@ -555,7 +556,7 @@ function install_bindist() {
# FIXME: The bindist configure script shouldn't need to be reminded of
# the target platform. See #21970.
if [ -n "${CROSS_TARGET:-}" ]; then
- args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" )
+ args+=( "--target=$CROSS_TARGET" )
fi
run ${CONFIGURE_WRAPPER:-} ./configure \
@@ -592,34 +593,14 @@ function test_hadrian() {
info "Cannot test cross-compiled build without CROSS_EMULATOR being set."
return
# special case for JS backend
- elif [ -n "${CROSS_TARGET:-}" ] && [ "${CROSS_EMULATOR:-}" == "js-emulator" ]; then
- # The JS backend doesn't support CROSS_EMULATOR logic yet
- unset CROSS_EMULATOR
- # run "hadrian test" directly, not using the bindist, even though it did get installed.
- # This is a temporary solution, See !9515 for the status of hadrian support.
- run_hadrian \
- test \
- --summary-junit=./junit.xml \
- --test-have-intree-files \
- --docs=none \
- "runtest.opts+=${RUNTEST_ARGS:-}" \
- "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \
- || fail "cross-compiled hadrian main testsuite"
- elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then
- run_hadrian \
- test \
- --summary-junit=./junit.xml \
- "runtest.opts+=${RUNTEST_ARGS:-}" \
- "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \
- || fail "hadrian main testsuite targetting $CROSS_TARGET"
- elif [ -n "${CROSS_TARGET:-}" ]; then
- local instdir="$TOP/_build/install"
- local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
- install_bindist _build/bindist/ghc-*/ "$instdir"
- echo 'main = putStrLn "hello world"' > expected
- run "$test_compiler" -package ghc "$TOP/.gitlab/hello.hs" -o hello
- ${CROSS_EMULATOR:-} ./hello > actual
- run diff expected actual
+# elif [ -n "${CROSS_TARGET:-}" ]; then
+# local instdir="$TOP/_build/install"
+# local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
+# install_bindist _build/bindist/ghc-*/ "$instdir"
+# echo 'main = putStrLn "hello world"' > expected
+# run "$test_compiler" -package ghc "$TOP/.gitlab/hello.hs" -o hello
+# ${CROSS_EMULATOR:-} ./hello > actual
+# run diff expected actual
elif [[ -n "${REINSTALL_GHC:-}" ]]; then
run_hadrian \
test \
=====================================
distrib/configure.ac.in
=====================================
@@ -47,7 +47,6 @@ FPTOOLS_SET_PLATFORMS_VARS
# Requires FPTOOLS_SET_PLATFORMS_VARS to be run first.
FP_FIND_ROOT
-# ToDo: if Stage1Only=YES, should be YES
CrossCompiling=NO
# If 'host' and 'target' differ, then this means we are building a cross-compiler.
if test "$target" != "$host" ; then
=====================================
hadrian/bindist/Makefile
=====================================
@@ -187,7 +187,9 @@ install_lib: lib/settings
$(INSTALL_DATA) $$i "$$dest/`dirname $$i`" ;; \
esac; \
done; \
- chmod ugo+rx "$$dest"/bin/*
+ if [ -d "$$dest/bin" ]; then \
+ chmod ugo+rx "$$dest"/bin/*; \
+ fi
# Work around #17418 on Darwin
if [ -e "${XATTR}" ]; then \
"${XATTR}" -c -r "$(DESTDIR)$(ActualLibsDir)"; \
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -130,7 +130,6 @@ INSTALL_DIR = $(INSTALL) -m 755 -d
#-----------------------------------------------------------------------------
# Build configuration
-CrossCompiling = @CrossCompiling@
CrossCompilePrefix = @CrossCompilePrefix@
GhcUnregisterised = @Unregisterised@
=====================================
hadrian/src/Oracles/TestSettings.hs
=====================================
@@ -23,8 +23,8 @@ testConfigFile = buildRoot <&> (-/- "test/ghcconfig")
data TestSetting = TestHostOS
| TestWORDSIZE
| TestTARGETPLATFORM
- | TestTargetOS_CPP
- | TestTargetARCH_CPP
+ | TestTargetOS
+ | TestTargetARCH
| TestRTSWay
| TestGhcStage
| TestGhcDebugAssertions
@@ -43,6 +43,7 @@ data TestSetting = TestHostOS
| TestLeadingUnderscore
| TestGhcPackageDb
| TestGhcLibDir
+ | TestCrossCompiling
deriving (Show)
-- | Lookup a test setting in @ghcconfig@ file.
@@ -54,8 +55,8 @@ testSetting key = do
TestHostOS -> "HostOS"
TestWORDSIZE -> "WORDSIZE"
TestTARGETPLATFORM -> "TARGETPLATFORM"
- TestTargetOS_CPP -> "TargetOS_CPP"
- TestTargetARCH_CPP -> "TargetARCH_CPP"
+ TestTargetOS -> "TargetOS"
+ TestTargetARCH -> "TargetARCH"
TestRTSWay -> "RTSWay"
TestGhcStage -> "GhcStage"
TestGhcDebugAssertions -> "GhcDebugAssertions"
@@ -74,6 +75,7 @@ testSetting key = do
TestLeadingUnderscore -> "LeadingUnderscore"
TestGhcPackageDb -> "GhcGlobalPackageDb"
TestGhcLibDir -> "GhcLibdir"
+ TestCrossCompiling -> "CrossCompiling"
-- | Get the RTS ways of the test compiler
testRTSSettings :: Action [String]
=====================================
hadrian/src/Packages.hs
=====================================
@@ -15,7 +15,7 @@ module Packages (
ghcPackages, isGhcPackage,
-- * Package information
- crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath,
+ crossPrefix, programBasename, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath,
rtsContext, rtsBuildPath, libffiBuildPath,
ensureConfigured
) where
@@ -185,9 +185,10 @@ programName Context {..} = do
-- use Cabal conditionals + a 'profiling' flag
-- to declare the executable name, and I'm not sure
-- this is allowed (or desired for that matter).
- return $ prefix ++ basename
- where
- basename
+ return $ prefix ++ programBasename way package
+
+programBasename :: Way -> Package -> String
+programBasename way package
| package == ghc = "ghc"
| package == ghciWrapper = "ghci" -- See Note [Hadrian's ghci-wrapper package]
| package == hpcBin = "hpc"
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Toolchain (ccProgram, tgtCCompiler, ccLinkProgram, tgtCCompilerLink)
import GHC.Toolchain.Program (prgFlags)
import qualified Data.Set as Set
import Oracles.Flavour
+import Debug.Trace
{-
Note [Binary distributions]
@@ -280,7 +281,7 @@ buildBinDistDir root conf at BindistConfig{..} = do
need $ map (bindistFilesDir -/-)
(["configure", "Makefile"] ++ bindistInstallFiles)
copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in")
- generateBuildMk >>= writeFile' (bindistFilesDir -/- "build.mk")
+ generateBuildMk conf >>= writeFile' (bindistFilesDir -/- "build.mk")
copyFile ("hadrian" -/- "cfg" -/- "default.target.in") (bindistFilesDir -/- "default.target.in")
copyFile ("hadrian" -/- "cfg" -/- "default.host.target.in") (bindistFilesDir -/- "default.host.target.in")
@@ -404,12 +405,16 @@ data Compressor = Gzip | Bzip2 | Xz
-- Information from the build configuration which needs to be propagated to config.mk.in
-generateBuildMk :: Action String
-generateBuildMk = do
- dynamicGhc <- askDynGhcPrograms Stage1
- rtsWays <- unwords . map show . Set.toList <$> interpretInContext (vanillaContext Stage1 rts) getRtsWays
+generateBuildMk :: BindistConfig -> Action String
+generateBuildMk BindistConfig{..} = do
+ dynamicGhc <- askDynGhcPrograms executable_stage
+ rtsWays <- unwords . map show . Set.toList <$> interpretInContext (vanillaContext library_stage rts) getRtsWays
+ cross <- crossStage executable_stage
+ traceShowM ("cross", library_stage, executable_stage, cross)
return $ unlines [ "GhcRTSWays" =. rtsWays
- , "DYNAMIC_GHC_PROGRAMS" =. yesNo dynamicGhc ]
+ -- MP: TODO just very hacky, should be one place where cross implies static (see programContext for where this is currently)
+ , "DYNAMIC_GHC_PROGRAMS" =. yesNo (dynamicGhc && not cross)
+ , "CrossCompiling" =. yesNo cross ]
where
=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -228,14 +228,8 @@ testRules = do
rel_runghc <- relative_path_stage (Stage0 InTreeLibs) runGhc
-- force stage0 program building for cross
- when cross $ need [rel_hpc, rel_haddock, rel_runghc]
+ --when cross $ need [rel_hpc, rel_haddock, rel_runghc]
- prog_ghc_pkg <- make_absolute rel_ghc_pkg
- prog_hsc2hs <- make_absolute rel_hsc2hs
- prog_hp2ps <- make_absolute rel_hp2ps
- prog_haddock <- make_absolute rel_haddock
- prog_hpc <- make_absolute rel_hpc
- prog_runghc <- make_absolute rel_runghc
ghcPath <- getCompilerPath testCompilerArg
@@ -246,11 +240,28 @@ testRules = do
[ "--interactive", "-v0", "-ignore-dot-ghci"
, "-fno-ghci-history", "-fprint-error-index-links=never"
]
+ -- MP: TODO wrong
ccPath <- queryTargetTarget stg (Toolchain.prgPath . Toolchain.ccProgram . Toolchain.tgtCCompiler)
ccFlags <- queryTargetTarget stg (unwords . Toolchain.prgFlags . Toolchain.ccProgram . Toolchain.tgtCCompiler)
pythonPath <- builderPath Python
+ testGhc <- testCompiler <$> userSetting defaultTestArgs
+ bindir <- getBinaryDirectory testGhc
+ cross <- getBooleanSetting TestCrossCompiling
+ test_target_platform <- getTestSetting TestTARGETPLATFORM
+ let cross_prefix = if cross then test_target_platform ++ "-" else ""
+
+ let exe_path :: Package -> String
+ exe_path pkg = bindir </> (cross_prefix ++ programBasename vanilla pkg) <.> exe
+
+ prog_ghc_pkg <- make_absolute (exe_path ghcPkg)
+ prog_hsc2hs <- make_absolute (exe_path hsc2hs)
+ prog_hp2ps <- make_absolute (exe_path hp2ps)
+ prog_haddock <- make_absolute (exe_path haddock)
+ prog_hpc <- make_absolute (exe_path hpc)
+ prog_runghc <- make_absolute (exe_path runGhc)
+
-- Set environment variables for test's Makefile.
-- TODO: Ideally we would define all those env vars in 'env', so that
-- Shake can keep track of them, but it is not as easy as it seems
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -3,7 +3,9 @@ module Settings.Builders.RunTest (runTestBuilderArgs
, runTestGhcFlags
, assertSameCompilerArgs
, outOfTreeCompilerArgs
- , TestCompilerArgs(..) ) where
+ , TestCompilerArgs(..)
+ , getBooleanSetting
+ , getTestSetting ) where
import Hadrian.Utilities
import qualified System.FilePath
@@ -21,6 +23,9 @@ import Settings.Program
import qualified Context.Type
import GHC.Toolchain.Target
+import Text.Read
+import GHC.Platform.ArchOS
+import Debug.Trace
getTestSetting :: TestSetting -> Action String
getTestSetting key = testSetting key
@@ -167,13 +172,18 @@ outOfTreeCompilerArgs = do
debugAssertions <- getBooleanSetting TestGhcDebugAssertions
+ let readArch :: String -> Maybe Arch
+ readArch = readMaybe
+
os <- getTestSetting TestHostOS
- arch <- getTestSetting TestTargetARCH_CPP
+ arch <- maybe "unknown" stringEncodeArch . readArch <$> getTestSetting TestTargetARCH
platform <- getTestSetting TestTARGETPLATFORM
- wordsize <- getTestSetting TestWORDSIZE
+ wordsize <- show . ((8 :: Int) *) . read <$> getTestSetting TestWORDSIZE
rtsWay <- getTestSetting TestRTSWay
let debugged = "debug" `isInfixOf` rtsWay
+ traceShowM (os, arch, platform)
+
llc_cmd <- getTestSetting TestLLC
have_llvm <- liftIO (isJust <$> findExecutable llc_cmd)
profiled <- getBooleanSetting TestGhcProfiled
@@ -322,14 +332,19 @@ runTestBuilderArgs = builder Testsuite ? do
-- | Command line arguments for running GHC's test script.
getTestArgs :: Args
getTestArgs = do
- stage <- getStage
-- targets specified in the TEST env var
testEnvTargets <- maybe [] words <$> expr (liftIO $ lookupEnv "TEST")
args <- expr $ userSetting defaultTestArgs
bindir <- expr $ getBinaryDirectory (testCompiler args)
compiler <- expr $ getCompilerPath (testCompiler args)
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
- cross_prefix <- expr (crossPrefix (succStage stage))
+
+ -- MP: Is it better to compute cross_prefix from testCompiler?
+ cross <- expr $ getBooleanSetting TestCrossCompiling
+ test_target <- expr $ getTestSetting TestTARGETPLATFORM
+ let cross_prefix = if cross then test_target ++ "-" else ""
+ traceShowM ("cross", cross, cross_prefix, test_target)
+
-- the testsuite driver will itself tell us if we need to generate the docs target
-- So we always pass the haddock path if the hadrian configuration allows us to build
-- docs
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -158,12 +158,11 @@ stage1Packages = do
, stm
, unlit
, xhtml
+ , haddock
+ , hpcBin
, if winTarget then win32 else unix
- ]
- , when (not cross)
- [ haddock
- , hpcBin
- , iserv
+ ] ++
+ [ iserv
, runGhc
, ghcToolchainBin
]
=====================================
testsuite/driver/testlib.py
=====================================
@@ -144,6 +144,7 @@ def js_skip( name, opts ):
# expect broken for the JS backend
def js_broken( bug: IssueNumber ):
+ print ("js_broken", js_arch())
if js_arch():
return expect_broken(bug);
else:
@@ -727,6 +728,7 @@ def opsys( os: str ) -> bool:
return config.os == os
def arch( arch: str ) -> bool:
+ print(arch, config.arch)
return config.arch == arch
def wordsize( ws: int ) -> bool:
=====================================
testsuite/ghc-config/ghc-config.hs
=====================================
@@ -9,15 +9,16 @@ main = do
info <- readProcess ghc ["+RTS", "--info"] ""
let fields = read info :: [(String,String)]
getGhcFieldOrFail fields "HostOS" "Host OS"
- getGhcFieldOrFail fields "WORDSIZE" "Word size"
- getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
- getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
- getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
getGhcFieldOrFail fields "RTSWay" "RTS way"
info <- readProcess ghc ["--info"] ""
let fields = read info :: [(String,String)]
+ getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
+ getGhcFieldOrFail fields "WORDSIZE" "target word size"
+ getGhcFieldOrFail fields "TargetOS" "target os"
+ getGhcFieldOrFail fields "TargetARCH" "target arch"
+
getGhcFieldOrFail fields "GhcStage" "Stage"
getGhcFieldOrFail fields "GhcDebugAssertions" "Debug on"
getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator"
@@ -28,6 +29,7 @@ main = do
getGhcFieldOrFail fields "GhcRTSWays" "RTS ways"
getGhcFieldOrFail fields "GhcLibdir" "LibDir"
getGhcFieldOrFail fields "GhcGlobalPackageDb" "Global Package DB"
+ getGhcFieldOrFail fields "CrossCompiling" "cross compiling"
getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO"
getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO"
getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66da8fae4614fcbfc7ed7a6802addb2ba2c724a1...c932319ccd2c02825cfdf34bb971920907e6c40a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66da8fae4614fcbfc7ed7a6802addb2ba2c724a1...c932319ccd2c02825cfdf34bb971920907e6c40a
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231004/73a29a7a/attachment-0001.html>
More information about the ghc-commits
mailing list