From ef4137d7e4a8f8f703278042e25f1ab0990ab4df Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Wed, 13 Jun 2018 15:58:25 +0530 Subject: [PATCH] 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 --- src/CommandLine.hs | 91 ++++++++++++++++++++++++-------- src/GHC.hs | 21 ++++---- src/GHC/Packages.hs | 15 +++--- src/Rules/Test.hs | 13 ++++- src/Settings/Builders/Make.hs | 23 +++++++- src/Settings/Builders/RunTest.hs | 37 +++++++++++-- src/Settings/Default.hs | 1 + 7 files changed, 154 insertions(+), 47 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 5aa476d4a0..b86b448d62 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,7 +1,8 @@ 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) diff --git a/src/GHC.hs b/src/GHC.hs index 037ecf6bf5..9a270db3f0 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -1,14 +1,15 @@ {-# 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 diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 5902396aa3..c9c6f2b283 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -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" diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index b7b234dd0f..dac2b2a275 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -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 diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index d231fd7e90..6f8768de1f 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,5 +1,7 @@ -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 + diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 24ee9c962e..6e1c5d1b59 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -1,10 +1,11 @@ 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 diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index e9ff8584a8..35bc1ac28b 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -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