Skip to content
This repository has been archived by the owner on Aug 2, 2020. It is now read-only.

Commit

Permalink
Added support for more testing features
Browse files Browse the repository at this point in the history
  • Loading branch information
@chitrak7
chitrak7 committed Jun 4, 2018
1 parent d3bd710 commit b439d95
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 22 deletions.
73 changes: 53 additions & 20 deletions src/CommandLine.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,23 +42,31 @@ defaultCommandLineArgs = CommandLineArgs

-- | These arguments are used by the `test` target.
data TestArgs = TestArgs
{ testOnly :: Maybe String
{ testConfigs :: [String]
, testJUnit :: Maybe FilePath
, testOnly :: Maybe String
, testOnlyPerf :: Bool
, testSkipPerf :: Bool
, testSpeed :: TestSpeed
, testSummary :: Maybe FilePath
, testJUnit :: Maybe FilePath
, testConfigs :: [String] }
, testThreads :: Maybe String
, testVerbosity:: Maybe String
, testWays :: [String] }
deriving (Eq, Show)

-- | Default value for `TestArgs`.
defaultTestArgs :: TestArgs
defaultTestArgs = TestArgs
{ testOnly = Nothing
{ testConfigs = []
, testJUnit = Nothing
, testOnly = Nothing
, testOnlyPerf = False
, testSkipPerf = False
, testSpeed = Average
, testSummary = Nothing
, testJUnit = Nothing
, testConfigs = [] }
, testThreads = Nothing
, testVerbosity= Nothing
, testWays = [] }

readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Right $ \flags -> flags { configure = True }
Expand Down Expand Up @@ -112,9 +120,23 @@ readProgressInfo ms =
readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
readSplitObjects = Right $ \flags -> flags { splitObjects = True }

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 } }

readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }

readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestOnly tests = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnly = tests } }

readTestOnlyPerf :: Either String (CommandLineArgs -> CommandLineArgs)
readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnlyPerf = True } }

readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }

Expand All @@ -133,17 +155,20 @@ readTestSpeed ms =
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 } }
readTestThreads :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestThreads thread = Right $ \flags -> flags { testArgs = (testArgs flags) { testThreads = thread } }

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 } }
readTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestVerbose verbose = Right $ \flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } }

readTestWays :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestWays ways =
case ways of
Nothing -> Right id
Just way -> Right $ \flags ->
let newWays = way : testWays (testArgs flags)
in flags { testArgs = (testArgs flags) {testWays = newWays} }

-- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
optDescrs =
Expand All @@ -165,19 +190,27 @@ optDescrs =
"Progress info style (None, Brief, Normal or Unicorn)."
, Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)."
, Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
"Configurations to run test, in key=value format."
, Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")
"Output testsuite summary in JUnit format."
, Option [] ["only"] (OptArg readTestOnly "TESTS")
"Test cases to run."
, Option [] ["only-perf"] (NoArg readTestOnlyPerf)
"Only run performance tests."
, Option [] ["skip-perf"] (NoArg readTestSkipPerf)
"Skip performance tests."
, Option [] ["test-speed"] (OptArg readTestSpeed "SPEED")
"fast, slow or normal. Normal by default"
, 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." ]

, Option [] ["test-threads"] (OptArg readTestThreads "TEST_THREADS")
"Number of concurrent parallel jobs"
, Option [] ["test-verbose"] (OptArg readTestVerbose "TEST_VERBOSE")
"A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output."
, Option [] ["test-way"] (OptArg readTestWays "TEST_WAY")
"only run these ways" ]

-- | A type-indexed map containing Hadrian command line arguments to be passed
-- to Shake via 'shakeExtra'.
cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
Expand Down
15 changes: 13 additions & 2 deletions src/Settings/Builders/RunTest.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,6 +100,9 @@ getTestArgs = do
let testOnlyArg = case testOnly args of
Just cases -> map ("--only=" ++) (words cases)
Nothing -> []
onlyPerfArg = if testOnlyPerf args
then Just "--only-perf-tests"
else Nothing
skipPerfArg = if testSkipPerf args
then Just "--skip-perf-tests"
else Nothing
Expand All @@ -111,11 +114,19 @@ getTestArgs = do
Just filepath -> Just $ "--junit " ++ quote filepath
Nothing -> Nothing
configArgs = concat [["-e", configArg] | configArg <- testConfigs args]

threadArg = case testThreads args of
Nothing -> Nothing
Just thread -> Just $ "--threads=" ++ thread
verbosityArg = case testVerbosity args of
Nothing -> Nothing
Just verbosity -> Just $ "--verbose=" ++ verbosity
wayArgs = map ("--way=" ++) (testWays args)
pure $ testOnlyArg
++ speedArg
++ catMaybes [skipPerfArg, summaryArg, junitArg]
++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
, junitArg, threadArg, verbosityArg ]
++ configArgs
++ wayArgs

-- | Set speed for test
setTestSpeed :: TestSpeed -> String
Expand Down

0 comments on commit b439d95

Please sign in to comment.