Commit 63a55638 authored by Tao He's avatar Tao He Committed by Andrey Mokhov

[WIP] Support run GHC's test from hadrian. (#495)

* Support run GHC's test from hadrian.

1. Necessary command line arguments to run test driver.
   + `--test-only=<TEST_CASE>`
   + `--test-skip-perf`
   + `--test-summary=<SUMMARY_FILE>`
   + `--test-junit=<SUMMARY_FILE>`
   + `--test-config=<EXTRA_TEST_CONFIG>`
2. Synchronize configurations from test.mk.
3. Synchronize GHC's compilation flags from test.mk (that's very important).

* The `RunTest` builder and `test` rule to run GHC's test.
* Timeout rules.
* Reduce boilerplate.
* Fix warning.
* Move getTestArgs into Settings.Builders.RunTest.
* Drop `validate` related code to avoid confusion.
* Replace explicit `chmod +x` with `makeExecutable`.
* Fix executable's extension.
parent fdc35b18
...@@ -26,6 +26,10 @@ perl = @PerlCmd@ ...@@ -26,6 +26,10 @@ perl = @PerlCmd@
ln-s = @LN_S@ ln-s = @LN_S@
xelatex = @XELATEX@ xelatex = @XELATEX@
# Python 3 is required to run test driver.
# See: https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk#L220
python = python3
# Information about builders: # Information about builders:
#============================ #============================
......
...@@ -78,6 +78,7 @@ executable hadrian ...@@ -78,6 +78,7 @@ executable hadrian
, Settings.Builders.HsCpp , Settings.Builders.HsCpp
, Settings.Builders.Ld , Settings.Builders.Ld
, Settings.Builders.Make , Settings.Builders.Make
, Settings.Builders.RunTest
, Settings.Builders.Xelatex , Settings.Builders.Xelatex
, Settings.Default , Settings.Default
, Settings.Flavours.Development , Settings.Flavours.Development
......
...@@ -87,6 +87,7 @@ data Builder = Alex ...@@ -87,6 +87,7 @@ data Builder = Alex
| Haddock HaddockMode | Haddock HaddockMode
| Happy | Happy
| Hpc | Hpc
| Hp2Ps
| HsCpp | HsCpp
| Hsc2Hs | Hsc2Hs
| Ld | Ld
...@@ -95,7 +96,9 @@ data Builder = Alex ...@@ -95,7 +96,9 @@ data Builder = Alex
| Objdump | Objdump
| Patch | Patch
| Perl | Perl
| Python
| Ranlib | Ranlib
| RunTest
| Sphinx SphinxMode | Sphinx SphinxMode
| Tar TarMode | Tar TarMode
| Unlit | Unlit
...@@ -121,6 +124,7 @@ builderProvenance = \case ...@@ -121,6 +124,7 @@ builderProvenance = \case
GhcPkg _ _ -> context Stage0 ghcPkg GhcPkg _ _ -> context Stage0 ghcPkg
Haddock _ -> context Stage2 haddock Haddock _ -> context Stage2 haddock
Hpc -> context Stage1 hpcBin Hpc -> context Stage1 hpcBin
Hp2Ps -> context Stage0 hp2ps
Hsc2Hs -> context Stage0 hsc2hs Hsc2Hs -> context Stage0 hsc2hs
Unlit -> context Stage0 unlit Unlit -> context Stage0 unlit
_ -> Nothing _ -> Nothing
...@@ -221,7 +225,9 @@ systemBuilderPath builder = case builder of ...@@ -221,7 +225,9 @@ systemBuilderPath builder = case builder of
Objdump -> fromKey "objdump" Objdump -> fromKey "objdump"
Patch -> fromKey "patch" Patch -> fromKey "patch"
Perl -> fromKey "perl" Perl -> fromKey "perl"
Python -> fromKey "python"
Ranlib -> fromKey "ranlib" Ranlib -> fromKey "ranlib"
RunTest -> fromKey "python"
Sphinx _ -> fromKey "sphinx-build" Sphinx _ -> fromKey "sphinx-build"
Tar _ -> fromKey "tar" Tar _ -> fromKey "tar"
Xelatex -> fromKey "xelatex" Xelatex -> fromKey "xelatex"
......
module CommandLine ( module CommandLine (
optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple, optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects, cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
cmdInstallDestDir cmdInstallDestDir, TestArgs(..), defaultTestArgs
) where ) where
import Data.Either import Data.Either
...@@ -21,7 +21,8 @@ data CommandLineArgs = CommandLineArgs ...@@ -21,7 +21,8 @@ data CommandLineArgs = CommandLineArgs
, integerSimple :: Bool , integerSimple :: Bool
, progressColour :: UseColour , progressColour :: UseColour
, progressInfo :: ProgressInfo , progressInfo :: ProgressInfo
, splitObjects :: Bool } , splitObjects :: Bool
, testArgs :: TestArgs }
deriving (Eq, Show) deriving (Eq, Show)
-- | Default values for 'CommandLineArgs'. -- | Default values for 'CommandLineArgs'.
...@@ -34,7 +35,26 @@ defaultCommandLineArgs = CommandLineArgs ...@@ -34,7 +35,26 @@ defaultCommandLineArgs = CommandLineArgs
, integerSimple = False , integerSimple = False
, progressColour = Auto , progressColour = Auto
, progressInfo = Brief , progressInfo = Brief
, splitObjects = False } , splitObjects = False
, testArgs = defaultTestArgs }
-- | These arguments are used by the `test` target.
data TestArgs = TestArgs
{ testOnly :: Maybe String
, testSkipPerf :: Bool
, testSummary :: Maybe FilePath
, testJUnit :: Maybe FilePath
, testConfigs :: [String] }
deriving (Eq, Show)
-- | Default value for `TestArgs`.
defaultTestArgs :: TestArgs
defaultTestArgs = TestArgs
{ testOnly = Nothing
, testSkipPerf = False
, testSummary = Nothing
, testJUnit = Nothing
, testConfigs = [] }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Right $ \flags -> flags { configure = True } readConfigure = Right $ \flags -> flags { configure = True }
...@@ -79,6 +99,26 @@ readProgressInfo ms = ...@@ -79,6 +99,26 @@ readProgressInfo ms =
readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs) readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
readSplitObjects = Right $ \flags -> flags { splitObjects = True } readSplitObjects = Right $ \flags -> flags { splitObjects = True }
readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestOnly tests = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnly = tests } }
readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
readTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestSummary filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
readTestConfig :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestConfig config =
case config of
Nothing -> Right id
Just conf -> Right $ \flags ->
let configs = conf : testConfigs (testArgs flags)
in flags { testArgs = (testArgs flags) { testConfigs = configs } }
-- | Standard 'OptDescr' descriptions of Hadrian's command line arguments. -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))] optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
optDescrs = optDescrs =
...@@ -97,7 +137,17 @@ optDescrs = ...@@ -97,7 +137,17 @@ optDescrs =
, Option [] ["progress-info"] (OptArg readProgressInfo "STYLE") , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal or Unicorn)." "Progress info style (None, Brief, Normal or Unicorn)."
, Option [] ["split-objects"] (NoArg readSplitObjects) , Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)." ] "Generate split objects (requires a full clean rebuild)."
, Option [] ["only"] (OptArg readTestOnly "TESTS")
"Test cases to run."
, Option [] ["skip-perf"] (NoArg readTestSkipPerf)
"Skip performance tests."
, Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY")
"Where to output the test summary file."
, Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")
"Output testsuite summary in JUnit format."
, Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
"Configurations to run test, in key=value format." ]
-- | A type-indexed map containing Hadrian command line arguments to be passed -- | A type-indexed map containing Hadrian command line arguments to be passed
-- to Shake via 'shakeExtra'. -- to Shake via 'shakeExtra'.
...@@ -107,6 +157,7 @@ cmdLineArgsMap = do ...@@ -107,6 +157,7 @@ cmdLineArgsMap = do
let args = foldl (flip id) defaultCommandLineArgs (rights opts) let args = foldl (flip id) defaultCommandLineArgs (rights opts)
return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
$ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
$ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest
$ insertExtra args Map.empty $ insertExtra args Map.empty
cmdLineArgs :: Action CommandLineArgs cmdLineArgs :: Action CommandLineArgs
......
...@@ -4,7 +4,7 @@ module Hadrian.Utilities ( ...@@ -4,7 +4,7 @@ module Hadrian.Utilities (
fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize, fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize,
-- * String manipulation -- * String manipulation
quote, yesNo, quote, yesNo, zeroOne,
-- * FilePath manipulation -- * FilePath manipulation
unifyPath, (-/-), unifyPath, (-/-),
...@@ -13,7 +13,7 @@ module Hadrian.Utilities ( ...@@ -13,7 +13,7 @@ module Hadrian.Utilities (
insertExtra, lookupExtra, userSetting, insertExtra, lookupExtra, userSetting,
-- * Paths -- * Paths
BuildRoot (..), buildRoot, isGeneratedSource, BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
-- * File system operations -- * File system operations
copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile, copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile,
...@@ -26,7 +26,6 @@ module Hadrian.Utilities ( ...@@ -26,7 +26,6 @@ module Hadrian.Utilities (
ProgressInfo (..), putProgressInfo, ProgressInfo (..), putProgressInfo,
renderAction, renderProgram, renderLibrary, renderBox, renderUnicorn, renderAction, renderProgram, renderLibrary, renderBox, renderUnicorn,
-- * Miscellaneous -- * Miscellaneous
(<&>), (%%>), cmdLineLengthLimit, (<&>), (%%>), cmdLineLengthLimit,
...@@ -115,6 +114,11 @@ yesNo :: Bool -> String ...@@ -115,6 +114,11 @@ yesNo :: Bool -> String
yesNo True = "YES" yesNo True = "YES"
yesNo False = "NO" yesNo False = "NO"
-- | Pretty-print a `Bool` as a @"1"@ or @"0"@ string
zeroOne :: Bool -> String
zeroOne True = "1"
zeroOne False = "0"
-- | Normalise a path and convert all path separators to @/@, even on Windows. -- | Normalise a path and convert all path separators to @/@, even on Windows.
unifyPath :: FilePath -> FilePath unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx unifyPath = toStandard . normaliseEx
...@@ -168,6 +172,13 @@ userSetting defaultValue = do ...@@ -168,6 +172,13 @@ userSetting defaultValue = do
extra <- shakeExtra <$> getShakeOptions extra <- shakeExtra <$> getShakeOptions
return $ lookupExtra defaultValue extra return $ lookupExtra defaultValue extra
-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the
-- setting is not found, return the provided default value instead.
userSettingRules :: Typeable a => a -> Rules a
userSettingRules defaultValue = do
extra <- shakeExtra <$> getShakeOptionsRules
return $ lookupExtra defaultValue extra
newtype BuildRoot = BuildRoot FilePath deriving Typeable newtype BuildRoot = BuildRoot FilePath deriving Typeable
-- | All build results are put into the 'buildRoot' directory. -- | All build results are put into the 'buildRoot' directory.
...@@ -176,6 +187,11 @@ buildRoot = do ...@@ -176,6 +187,11 @@ buildRoot = do
BuildRoot path <- userSetting (BuildRoot "") BuildRoot path <- userSetting (BuildRoot "")
return path return path
buildRootRules :: Rules FilePath
buildRootRules = do
BuildRoot path <- userSettingRules (BuildRoot "")
return path
-- | A version of 'fmap' with flipped arguments. Useful for manipulating values -- | A version of 'fmap' with flipped arguments. Useful for manipulating values
-- in context, e.g. 'buildRoot', as in the example below. -- in context, e.g. 'buildRoot', as in the example below.
-- --
......
module Rules.Test (testRules) where module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
import Base import Base
import Expression import Expression
import Flavour
import Oracles.Flag import Oracles.Flag
import Oracles.Setting import Oracles.Setting
import Settings
import Target import Target
import Utilities import Utilities
import System.Environment
-- TODO: clean up after testing -- TODO: clean up after testing
testRules :: Rules () testRules :: Rules ()
testRules = do testRules = do
root <- buildRootRules
root -/- timeoutPyPath ~> do
copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPyPath)
-- TODO windows is still not supported.
--
-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
root -/- timeoutProgPath ~> do
python <- builderPath Python
need [root -/- timeoutPyPath]
let script = unlines
[ "#!/usr/bin/env sh"
, "exec " ++ python ++ " $0.py \"$@\""
]
liftIO $ do
writeFile (root -/- timeoutProgPath) script
makeExecutable (root -/- timeoutProgPath)
"validate" ~> do "validate" ~> do
need inplaceLibCopyTargets need inplaceLibCopyTargets
needBuilder $ Ghc CompileHs Stage2 needBuilder $ Ghc CompileHs Stage2
...@@ -24,49 +44,62 @@ testRules = do ...@@ -24,49 +44,62 @@ testRules = do
build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
"test" ~> do "test" ~> do
pkgs <- stagePackages Stage1 -- Prepare the timeout program.
tests <- filterM doesDirectoryExist $ concat need [ root -/- timeoutProgPath ]
[ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
| pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ] -- TODO This approach doesn't work.
windows <- windowsHost -- Set environment variables for test's Makefile.
top <- topDirectory env <- sequence
compiler <- builderPath $ Ghc CompileHs Stage2 [ builderEnvironment "MAKE" $ Make ""
ghcPkg <- builderPath $ GhcPkg Update Stage1 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
haddock <- builderPath (Haddock BuildPackage) , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
threads <- shakeThreads <$> getShakeOptions
debugged <- ghcDebugged <$> flavour makePath <- builderPath $ Make ""
ghcWithNativeCodeGenInt <- fromEnum <$> ghcWithNativeCodeGen top <- topDirectory
ghcWithInterpreterInt <- fromEnum <$> ghcWithInterpreter ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
ghcUnregisterisedInt <- fromEnum <$> flag GhcUnregisterised ghcFlags <- runTestGhcFlags
quietly . cmd "python2" $
[ "testsuite/driver/runtests.py" ] -- Set environment variables for test's Makefile.
++ map ("--rootdir="++) tests ++ liftIO $ do
[ "-e", "windows=" ++ show windows setEnv "MAKE" makePath
, "-e", "config.speed=2" setEnv "TEST_HC" ghcPath
, "-e", "ghc_compiler_always_flags=" ++ show "-fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-db -rtsopts" setEnv "TEST_HC_OPTS" ghcFlags
, "-e", "ghc_with_native_codegen=" ++ show ghcWithNativeCodeGenInt
, "-e", "ghc_debugged=" ++ show (yesNo debugged) -- Execute the test target.
, "-e", "ghc_with_vanilla=1" -- TODO: do we always build vanilla? buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
, "-e", "ghc_with_dynamic=0" -- TODO: support dynamic
, "-e", "ghc_with_profiling=0" -- TODO: support profiling -- | Extra flags to send to the Haskell compiler to run tests.
, "-e", "ghc_with_interpreter=" ++ show ghcWithInterpreterInt runTestGhcFlags :: Action String
, "-e", "ghc_unregisterised=" ++ show ghcUnregisterisedInt runTestGhcFlags = do
, "-e", "ghc_with_threaded_rts=0" -- TODO: support threaded unregisterised <- flag GhcUnregisterised
, "-e", "ghc_with_dynamic_rts=0" -- TODO: support dynamic
, "-e", "ghc_dynamic_by_default=False" -- TODO: support dynamic let ifMinGhcVer ver opt = do v <- ghcCanonVersion
, "-e", "ghc_dynamic=0" -- TODO: support dynamic if ver <= v then pure opt
, "-e", "ghc_with_llvm=0" -- TODO: support LLVM else pure ""
, "-e", "in_tree_compiler=True" -- TODO: when is it equal to False?
, "-e", "clean_only=False" -- TODO: do we need to support True? -- Read extra argument for test from command line, like `-fvectorize`.
, "--configfile=testsuite/config/ghc" ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS")
, "--config", "compiler=" ++ show (top -/- compiler)
, "--config", "ghc_pkg=" ++ show (top -/- ghcPkg) -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28
, "--config", "haddock=" ++ show (top -/- haddock) let ghcExtraFlags = if unregisterised
, "--summary-file", "testsuite_summary.txt" then "-optc-fno-builtin"
, "--threads=" ++ show threads else ""
]
-- Take flags to send to the Haskell compiler from test.mk.
-- , "--config", "hp2ps=" ++ quote ("hp2ps") -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
-- , "--config", "hpc=" ++ quote ("hpc") unwords <$> sequence
-- , "--config", "gs=$(call quote_path,$(GS))" [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
-- , "--config", "timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))" , pure ghcOpts
, pure ghcExtraFlags
, ifMinGhcVer "711" "-fno-warn-missed-specialisations"
, ifMinGhcVer "711" "-fshow-warning-groups"
, ifMinGhcVer "801" "-fdiagnostics-color=never"
, ifMinGhcVer "801" "-fno-diagnostics-show-caret"
, pure "-dno-debug-output"
]
timeoutPyPath :: FilePath
timeoutPyPath = "test/bin/timeout.py"
timeoutProgPath :: FilePath
timeoutProgPath = "test/bin/timeout" <.> exe
module Settings.Builders.RunTest (runTestBuilderArgs) where
import Hadrian.Utilities
import Hadrian.Haskell.Cabal
import Flavour
import Rules.Test
import Settings.Builders.Common
import Settings.Builders.Ghc
import CommandLine ( TestArgs(..), defaultTestArgs )
-- Arguments to send to the runtest.py script.
runTestBuilderArgs :: Args
runTestBuilderArgs = builder RunTest ? do
pkgs <- expr $ stagePackages Stage1
libTests <- expr $ filterM doesDirectoryExist $ concat
[ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
| pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
debugged <- ghcDebugged <$> expr flavour
withNativeCodeGen <- expr ghcWithNativeCodeGen
withInterpreter <- expr ghcWithInterpreter
unregisterised <- expr $ flag GhcUnregisterised
withSMP <- expr ghcWithSMP
windows <- expr windowsHost
darwin <- expr osxHost
threads <- shakeThreads <$> expr getShakeOptions
verbose <- shakeVerbosity <$> expr getShakeOptions
top <- expr topDirectory
compiler <- expr $ builderPath $ Ghc CompileHs Stage2
ghcPkg <- expr $ builderPath $ GhcPkg Update Stage1
haddock <- expr $ builderPath $ Haddock BuildPackage
hp2ps <- expr $ builderPath $ Hp2Ps
hpc <- expr $ builderPath $ Hpc
ghcFlags <- expr runTestGhcFlags
timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath)
mconcat [ arg $ "testsuite/driver/runtests.py"
, arg $ "--rootdir=" ++ ("testsuite" -/- "tests")
, pure ["--rootdir=" ++ test | test <- libTests]
, arg "-e", arg $ "windows=" ++ show windows
, arg "-e", arg $ "darwin=" ++ show darwin
, arg "-e", arg $ "config.speed=2" -- Use default value in GHC's test.mk
, arg "-e", arg $ "config.local=True"
, arg "-e", arg $ "config.cleanup=False" -- Don't clean up.
, arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
, arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged)
, arg "-e", arg $ "ghc_with_native_codegen=" ++ zeroOne withNativeCodeGen
, arg "-e", arg $ "config.have_interp=" ++ show withInterpreter
, arg "-e", arg $ "config.unregisterised=" ++ show unregisterised
, arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags
, arg "-e", arg $ "ghc_with_vanilla=1" -- TODO: do we always build vanilla?
, arg "-e", arg $ "ghc_with_dynamic=0" -- TODO: support dynamic
, arg "-e", arg $ "ghc_with_profiling=0" -- TODO: support profiling
, arg "-e", arg $ "config.have_vanilla=1" -- TODO: support other build context
, arg "-e", arg $ "config.have_dynamic=0" -- TODO: support dynamic
, arg "-e", arg $ "config.have_profiling=0" -- TODO: support profiling
, arg "-e", arg $ "ghc_with_smp=" ++ zeroOne withSMP
, arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM
, arg "-e", arg $ "ghc_with_threaded_rts=0" -- TODO: support threaded
, arg "-e", arg $ "ghc_with_dynamic_rts=0" -- TODO: support dynamic
, arg "-e", arg $ "config.ghc_dynamic_by_default=False" -- TODO: support dynamic
, arg "-e", arg $ "config.ghc_dynamic=False" -- TODO: support dynamic
, arg "-e", arg $ "config.in_tree_compiler=True" -- Use default value, see https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk
, arg "--config-file=testsuite/config/ghc"
, arg "--config", arg $ "compiler=" ++ show (top -/- compiler)
, arg "--config", arg $ "ghc_pkg=" ++ show (top -/- ghcPkg)
, arg "--config", arg $ "haddock=" ++ show (top -/- haddock)
, arg "--config", arg $ "hp2ps=" ++ show (top -/- hp2ps)
, arg "--config", arg $ "hpc=" ++ show (top -/- hpc)
, arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk
, arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg)
, arg $ "--threads=" ++ show threads
, arg $ "--verbose=" ++ show (fromEnum verbose)
, getTestArgs -- User-provided arguments from command line.
]
-- | Prepare the command-line arguments to run GHC's test script.
getTestArgs :: Args
getTestArgs = do
args <- expr $ userSetting defaultTestArgs
let testOnlyArg = case testOnly args of
Just cases -> map ("--only=" ++) (words cases)
Nothing -> []
skipPerfArg = if testSkipPerf args
then Just "--skip-perf-tests"
else Nothing
summaryArg = case testSummary args of
Just filepath -> Just $ "--summary-file" ++ quote filepath
Nothing -> Just $ "--summary-file=testsuite_summary.txt"
junitArg = case testJUnit args of
Just filepath -> Just $ "--junit " ++ quote filepath
Nothing -> Nothing
configArgs = map ("-e " ++) (testConfigs args)
pure $ testOnlyArg ++ catMaybes [skipPerfArg, summaryArg, junitArg] ++ configArgs
...@@ -28,6 +28,7 @@ import Settings.Builders.Hsc2Hs ...@@ -28,6 +28,7 @@ import Settings.Builders.Hsc2Hs
import Settings.Builders.HsCpp import Settings.Builders.HsCpp
import Settings.Builders.Ld import Settings.Builders.Ld
import Settings.Builders.Make import Settings.Builders.Make
import Settings.Builders.RunTest
import Settings.Builders.Xelatex import Settings.Builders.Xelatex
import Settings.Packages.Base import Settings.Packages.Base
import Settings.Packages.Cabal import Settings.Packages.Cabal
...@@ -144,6 +145,7 @@ defaultBuilderArgs = mconcat ...@@ -144,6 +145,7 @@ defaultBuilderArgs = mconcat
, hsCppBuilderArgs , hsCppBuilderArgs
, ldBuilderArgs , ldBuilderArgs
, makeBuilderArgs , makeBuilderArgs
, runTestBuilderArgs
, xelatexBuilderArgs , xelatexBuilderArgs
-- Generic builders from the Hadrian library: -- Generic builders from the Hadrian library:
, builder (Ar Pack ) ? Hadrian.Builder.Ar.args Pack , builder (Ar Pack ) ? Hadrian.Builder.Ar.args Pack
......
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