From 831e1ce04983f640a1234f7706fa4ba975ae6a92 Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Fri, 15 Jun 2018 20:11:40 +0530 Subject: [PATCH] Add config file and test speed options to testsuite (#624) * Added option to specify config file * Added speed setting for validation * Revision --- src/CommandLine.hs | 50 +++++++++++++++++++------------- src/Settings/Builders/Make.hs | 9 +++++- src/Settings/Builders/RunTest.hs | 6 ++-- 3 files changed, 41 insertions(+), 24 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 18ddbbca94..76e2357c87 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -45,31 +45,33 @@ defaultCommandLineArgs = CommandLineArgs -- | These arguments are used by the `test` target. data TestArgs = TestArgs - { testCompiler :: String - , testConfigs :: [String] - , testJUnit :: Maybe FilePath - , testOnly :: Maybe String - , testOnlyPerf :: Bool - , testSkipPerf :: Bool - , testSpeed :: TestSpeed - , testSummary :: Maybe FilePath - , testVerbosity:: Maybe String - , testWays :: [String] } + { testCompiler :: String + , testConfigFile :: String + , testConfigs :: [String] + , testJUnit :: Maybe FilePath + , testOnly :: Maybe String + , testOnlyPerf :: Bool + , testSkipPerf :: Bool + , testSpeed :: TestSpeed + , testSummary :: Maybe FilePath + , testVerbosity :: Maybe String + , testWays :: [String] } deriving (Eq, Show) -- | Default value for `TestArgs`. defaultTestArgs :: TestArgs defaultTestArgs = TestArgs - { testCompiler = "stage2" - , testConfigs = [] - , testJUnit = Nothing - , testOnly = Nothing - , testOnlyPerf = False - , testSkipPerf = False - , testSpeed = Average - , testSummary = Nothing - , testVerbosity= Nothing - , testWays = [] } + { testCompiler = "stage2" + , testConfigFile = "testsuite/config/ghc" + , testConfigs = [] + , testJUnit = Nothing + , testOnly = Nothing + , testOnlyPerf = False + , testSkipPerf = False + , testSpeed = Fast + , testSummary = Nothing + , testVerbosity = Nothing + , testWays = [] } readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure = Right $ \flags -> flags { configure = True } @@ -136,6 +138,12 @@ readTestConfig config = let configs = conf : testConfigs (testArgs flags) in flags { testArgs = (testArgs flags) { testConfigs = configs } } +readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) +readTestConfigFile filepath = + maybe (Left "Cannot parse test-speed") (Right . set) filepath + where + set filepath flags = flags { testArgs = (testArgs flags) { testConfigFile = filepath } } + readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } } @@ -197,6 +205,8 @@ optDescrs = "Generate split objects (requires a full clean rebuild)." , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER") "Use given compiler [Default=stage2]." + , Option [] ["test-config-file"] (OptArg readTestConfigFile "CONFIG_FILE") + "congiguration file for testsuite. Default=testsuite/config/ghc" , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG") "Configurations to run test, in key=value format." , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT") diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index f366b83660..a27e4b4e7f 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -4,6 +4,7 @@ import GHC import Oracles.Setting import Rules.Gmp import Settings.Builders.Common +import CommandLine makeBuilderArgs :: Args makeBuilderArgs = do @@ -23,7 +24,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do compiler <- expr $ fullpath ghc checkPpr <- expr $ fullpath checkPpr checkApiAnnotations <- expr $ fullpath checkApiAnnotations - return [ "fast" + args <- expr $ userSetting defaultTestArgs + return [ setTestSpeed $ testSpeed args , "THREADS=" ++ show threads , "TEST_HC=" ++ (top -/- compiler) , "CHECK_PPR=" ++ (top -/- checkPpr) @@ -33,3 +35,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do fullpath :: Package -> Action FilePath fullpath pkg = programPath =<< programContext Stage1 pkg +-- | Support for speed of validation +setTestSpeed :: TestSpeed -> String +setTestSpeed Fast = "fasttest" +setTestSpeed Average = "test" +setTestSpeed Slow = "slowtest" diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 1feef055b2..41da284318 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -80,7 +80,6 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.arch=" ++ show arch , arg "-e", arg $ "config.platform=" ++ show platform - , arg "--config-file=testsuite/config/ghc" , 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 @@ -94,7 +93,8 @@ getTestArgs = do bindir <- expr $ setBinaryDirectory (testCompiler args) compiler <- expr $ setCompiler (testCompiler args) globalVerbosity <- shakeVerbosity <$> expr getShakeOptions - let testOnlyArg = case testOnly args of + let configFileArg= ["--config-file=" ++ (testConfigFile args)] + testOnlyArg = case testOnly args of Just cases -> map ("--only=" ++) (words cases) Nothing -> [] onlyPerfArg = if testOnlyPerf args @@ -120,7 +120,7 @@ getTestArgs = do haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")] hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")] hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] - pure $ testOnlyArg ++ speedArg + pure $ configFileArg ++ testOnlyArg ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg , junitArg, verbosityArg ] ++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg -- GitLab