Commit ef4137d7 authored by Chitrak Raj Gupta's avatar Chitrak Raj Gupta Committed by Andrey Mokhov

Added support for testsuite (#602)

* Rule for testsuite dependencies

* Separated validate builder arguments

* Added RunTest config options

* added support to set test speed with runtest

* Fixed minor bug with testConfigs

Removed indentation error

* Added support for more testing features

* Rectified Merge Errors

* Removed need rule for Hp2ps

* using all available threads

* Minor Revision

* Removed TestThread argument

* Update Utilities.hs
parent a63ad329
module CommandLine (
optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
cmdInstallDestDir, lookupBuildRoot, TestArgs(..), defaultTestArgs
cmdInstallDestDir, lookupBuildRoot, TestArgs(..), TestSpeed(..),
defaultTestArgs
) where
import Data.Either
......@@ -12,6 +13,8 @@ import Hadrian.Utilities hiding (buildRoot)
import System.Console.GetOpt
import System.Environment
data TestSpeed = Slow | Average | Fast deriving (Show, Eq)
-- | All arguments that can be passed to Hadrian via the command line.
data CommandLineArgs = CommandLineArgs
{ configure :: Bool
......@@ -42,21 +45,29 @@ 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] }
, 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 = [] }
, testVerbosity= Nothing
, testWays = [] }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Right $ \flags -> flags { configure = True }
......@@ -110,26 +121,52 @@ 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 } }
readTestSpeed :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestSpeed ms =
maybe (Left "Cannot parse test-speed") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe TestSpeed
go "fast" = Just Fast
go "slow" = Just Slow
go "average" = Just Average
go _ = Nothing
set :: TestSpeed -> CommandLineArgs -> CommandLineArgs
set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }
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 } }
readTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestVerbose verbose = Right $ \flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } }
readTestWay :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestWay 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 =
......@@ -151,17 +188,25 @@ 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-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 readTestWay "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)
......
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module GHC (
-- * GHC packages
array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler,
containers, deepseq, deriveConstants, directory, filepath, genapply,
genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghcHeap, ghci,
ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc,
hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl, parsec,
parallel, pretty, process, rts, runGhc, stm, templateHaskell, terminfo,
text, time, touchy, transformers, unlit, unix, win32, xhtml, ghcPackages,
isGhcPackage, defaultPackages, testsuitePackages,
array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal,
ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock,
haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv,
libffi, libiserv, mtl, parsec, parallel, pretty, primitive, process, rts,
runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers,
unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages,
testsuitePackages,
-- * Package information
programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
......@@ -103,7 +104,9 @@ stage2Packages = return [haddock]
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = return [checkPpr]
testsuitePackages = return [ checkApiAnnotations
, checkPpr
, hp2ps ]
-- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC
......
......@@ -11,13 +11,13 @@ import Hadrian.Utilities
-- modify build default build conditions in "UserSettings".
ghcPackages :: [Package]
ghcPackages =
[ array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler
, containers, deepseq, deriveConstants, directory, filepath, genapply
, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, ghcHeap, ghci, ghcPkg
, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp
, integerSimple, iserv, libffi, libiserv, mtl, parsec, parallel, pretty
, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy
, transformers, unlit, unix, win32, xhtml ]
[ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations
, compareSizes, compiler, containers, deepseq, deriveConstants, directory
, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact
, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps
, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
, parsec, parallel, pretty, process, rts, runGhc, stm, templateHaskell
, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml ]
-- TODO: Optimise by switching to sets of packages.
isGhcPackage :: Package -> Bool
......@@ -29,6 +29,7 @@ base = hsLib "base"
binary = hsLib "binary"
bytestring = hsLib "bytestring"
cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal"
checkApiAnnotations = hsUtil "check-api-annotations"
checkPpr = hsUtil "check-ppr"
compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes"
compiler = hsTop "ghc" `setPath` "compiler"
......
......@@ -5,6 +5,7 @@ import Expression
import GHC
import Oracles.Flag
import Oracles.Setting
import Settings
import Target
import Utilities
......@@ -63,13 +64,23 @@ testRules = do
-- Execute the test target.
buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
-- | Build extra programs required by testsuite
needTestsuiteBuilders :: Action ()
needTestsuiteBuilders = do
targets <- mapM (needfile Stage1) =<< testsuitePackages
need targets
where
needfile :: Stage -> Package -> Action FilePath
needfile stage pkg = programPath =<< programContext stage pkg
needTestBuilders :: Action ()
needTestBuilders = do
needBuilder $ Ghc CompileHs Stage2
needBuilder $ GhcPkg Update Stage1
needBuilder Hp2Ps
needBuilder Hpc
needBuilder (Hsc2Hs Stage1)
needTestsuiteBuilders
-- | Extra flags to send to the Haskell compiler to run tests.
runTestGhcFlags :: Action String
......
module Settings.Builders.Make (makeBuilderArgs) where
module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where
import GHC
import Oracles.Setting
import Rules.Gmp
import Rules.Libffi
import Settings.Builders.Common
......@@ -13,5 +15,22 @@ makeBuilderArgs = do
mconcat
[ builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t]
, builder (Make libffiPath ) ? pure ["MAKEFLAGS=-j" ++ t, "install"]
, builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"]
]
validateBuilderArgs :: Args
validateBuilderArgs = builder (Make "testsuite/tests") ? do
threads <- shakeThreads <$> expr getShakeOptions
top <- expr topDirectory
compiler <- expr $ fullpath ghc
checkPpr <- expr $ fullpath checkPpr
checkApiAnnotations <- expr $ fullpath checkApiAnnotations
return [ "fast"
, "THREADS=" ++ show threads
, "TEST_HC=" ++ (top -/- compiler)
, "CHECK_PPR=" ++ (top -/- checkPpr)
, "CHECK_API_ANNOTATIONS=" ++ (top -/- checkApiAnnotations)
]
where
fullpath :: Package -> Action FilePath
fullpath pkg = programPath =<< programContext Stage1 pkg
module Settings.Builders.RunTest (runTestBuilderArgs) where
import CommandLine (TestArgs(..), defaultTestArgs)
import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..))
import Flavour
import GHC.Packages
import Hadrian.Builder (getBuilderPath)
import Hadrian.Utilities
import Oracles.Setting (setting)
import Rules.Test
import Settings.Builders.Common
......@@ -28,7 +29,9 @@ runTestBuilderArgs = builder RunTest ? do
threads <- shakeThreads <$> expr getShakeOptions
verbose <- shakeVerbosity <$> expr getShakeOptions
os <- expr $ setting TargetOs
arch <- expr $ setting TargetArch
platform <- expr $ setting TargetPlatform
top <- expr topDirectory
compiler <- getBuilderPath $ Ghc CompileHs Stage2
ghcPkg <- getBuilderPath $ GhcPkg Update Stage1
......@@ -71,7 +74,12 @@ runTestBuilderArgs = builder RunTest ? do
, 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 "-e", arg $ "config.top=" ++ show (top -/- "testsuite")
, arg "-e", arg $ "config.wordsize=\"64\""
, arg "-e", arg $ "config.os=" ++ show os
, arg "-e", arg $ "config.arch=" ++ show arch
, arg "-e", arg $ "config.platform=" ++ show platform
, arg "--config-file=testsuite/config/ghc"
, arg "--config", arg $ "compiler=" ++ show (top -/- compiler)
, arg "--config", arg $ "ghc_pkg=" ++ show (top -/- ghcPkg)
......@@ -92,15 +100,34 @@ 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
speedArg = ["-e", "config.speed=" ++ setTestSpeed (testSpeed args)]
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)
configArgs = concat [["-e", configArg] | configArg <- testConfigs args]
verbosityArg = case testVerbosity args of
Nothing -> Nothing
Just verbosity -> Just $ "--verbose=" ++ verbosity
wayArgs = map ("--way=" ++) (testWays args)
pure $ testOnlyArg
++ speedArg
++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
, junitArg, verbosityArg ]
++ configArgs
++ wayArgs
-- | Set speed for test
setTestSpeed :: TestSpeed -> String
setTestSpeed Fast = "2"
setTestSpeed Average = "1"
setTestSpeed Slow = "0"
pure $ testOnlyArg ++ catMaybes [skipPerfArg, summaryArg, junitArg] ++ configArgs
......@@ -139,6 +139,7 @@ defaultBuilderArgs = mconcat
, ldBuilderArgs
, makeBuilderArgs
, runTestBuilderArgs
, validateBuilderArgs
, xelatexBuilderArgs
-- Generic builders from the Hadrian library:
, 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