From 39e3cc23f39cb83d14f5bc234209249d1747a186 Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Sat, 26 May 2018 16:47:02 +0530 Subject: [PATCH 01/12] Rule for testsuite dependencies --- src/GHC.hs | 22 ++++++++++++---------- src/GHC/Packages.hs | 15 ++++++++------- src/Rules/Test.hs | 13 +++++++++++++ 3 files changed, 33 insertions(+), 17 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 037ecf6bf5..30cec78d9c 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -1,14 +1,14 @@ {-# 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, checkPpr, checkApiAnnotations, + 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, -- * Package information programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, @@ -103,7 +103,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 @@ -138,7 +140,7 @@ programPath context@Context {..} = do -- which is likely just a historical accident that will hopefully be fixed. -- See: https://github.com/snowleopard/hadrian/issues/570 -- Likewise for 'unlit'. - path <- if package `elem` [touchy, unlit] + path <- if package `elem` [touchy, unlit, iservBin] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage pgm <- programName context 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..85c5e22316 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,6 +64,17 @@ 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 | isLibrary pkg = pkgConfFile (Context stage pkg vanilla) + | otherwise = programPath =<< programContext stage pkg + + needTestBuilders :: Action () needTestBuilders = do needBuilder $ Ghc CompileHs Stage2 @@ -70,6 +82,7 @@ needTestBuilders = do needBuilder Hp2Ps needBuilder Hpc needBuilder (Hsc2Hs Stage1) + needTestsuiteBuilders -- | Extra flags to send to the Haskell compiler to run tests. runTestGhcFlags :: Action String From 0d6050bdc2afa8b38e8ade697b4e38a77031e2da Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Fri, 1 Jun 2018 18:39:54 +0530 Subject: [PATCH 02/12] Separated validate builder arguments --- src/Settings/Builders/Make.hs | 22 ++++++++++++++++++++-- src/Settings/Default.hs | 1 + 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index d231fd7e90..f199c32833 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,4 +1,4 @@ -module Settings.Builders.Make (makeBuilderArgs) where +module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where import Rules.Gmp import Rules.Libffi @@ -13,5 +13,23 @@ 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 <- getBuilderPath $ Ghc CompileHs Stage2 + checkPpr <- expr $ fullpath checkPpr + checkApiAnnotations <- expr $ fullpath checkApiAnnotations + let t = show $ max 4 (threads - 2) + return [ "fast" + , "THREADS=" ++ t + , "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/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 From fffd8761ee9077745cc664914daab359040ed954 Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Fri, 1 Jun 2018 20:57:31 +0530 Subject: [PATCH 03/12] Added RunTest config options --- src/Settings/Builders/Make.hs | 4 +++- src/Settings/Builders/RunTest.hs | 14 ++++++++++++-- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index f199c32833..9058eed948 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,5 +1,7 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where +import GHC +import Oracles.Setting import Rules.Gmp import Rules.Libffi import Settings.Builders.Common @@ -19,7 +21,7 @@ validateBuilderArgs :: Args validateBuilderArgs = builder (Make "testsuite/tests") ? do threads <- shakeThreads <$> expr getShakeOptions top <- expr topDirectory - compiler <- getBuilderPath $ Ghc CompileHs Stage2 + compiler <- expr $ fullpath ghc checkPpr <- expr $ fullpath checkPpr checkApiAnnotations <- expr $ fullpath checkApiAnnotations let t = show $ max 4 (threads - 2) diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 24ee9c962e..33203ed179 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -5,6 +5,7 @@ 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,10 @@ 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 +75,13 @@ 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) From a6b5e05d12e6bf6e6315b8c8ff03553d9734771b Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Sat, 2 Jun 2018 16:26:33 +0530 Subject: [PATCH 04/12] added support to set test speed with runtest --- src/CommandLine.hs | 18 +++++++++++++++++- src/Hadrian/Utilities.hs | 8 +++++++- src/Settings/Builders/RunTest.hs | 15 ++++++++++++--- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 5aa476d4a0..8e9f283cc1 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -44,6 +44,7 @@ defaultCommandLineArgs = CommandLineArgs data TestArgs = TestArgs { testOnly :: Maybe String , testSkipPerf :: Bool + , testSpeed :: TestSpeed , testSummary :: Maybe FilePath , testJUnit :: Maybe FilePath , testConfigs :: [String] } @@ -54,6 +55,7 @@ defaultTestArgs :: TestArgs defaultTestArgs = TestArgs { testOnly = Nothing , testSkipPerf = False + , testSpeed = Average , testSummary = Nothing , testJUnit = Nothing , testConfigs = [] } @@ -116,6 +118,18 @@ readTestOnly tests = Right $ \flags -> flags { testArgs = (testArgs flags) { tes 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 } } @@ -128,7 +142,7 @@ readTestConfig config = Nothing -> Right id Just conf -> Right $ \flags -> let configs = conf : testConfigs (testArgs flags) - in flags { testArgs = (testArgs flags) { testConfigs = configs } } + in flags { testArgs = (testArgs flags) { testConfigs = configs } } -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments. optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))] @@ -155,6 +169,8 @@ optDescrs = "Test cases to run." , 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") diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index 4ef0970b59..c589660655 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -30,7 +30,10 @@ module Hadrian.Utilities ( (<&>), (%%>), cmdLineLengthLimit, -- * Useful re-exports - Dynamic, fromDynamic, toDyn, TypeRep, typeOf + Dynamic, fromDynamic, toDyn, TypeRep, typeOf, + + -- * Testsuite Settings + TestSpeed (..) ) where import Control.Monad.Extra @@ -481,3 +484,6 @@ renderUnicorn ls = ponyPadding = " " boxLines :: [String] boxLines = ["", "", ""] ++ (lines . renderBox $ ls) + +data TestSpeed = Slow | Average | Fast deriving (Show, Eq) + diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 33203ed179..b48ab3ba83 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -29,7 +29,6 @@ runTestBuilderArgs = builder RunTest ? do threads <- shakeThreads <$> expr getShakeOptions verbose <- shakeVerbosity <$> expr getShakeOptions - os <- expr $ setting TargetOs arch <- expr $ setting TargetArch platform <- expr $ setting TargetPlatform @@ -77,7 +76,6 @@ runTestBuilderArgs = builder RunTest ? do , 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 @@ -105,6 +103,7 @@ getTestArgs = do 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" @@ -113,4 +112,14 @@ getTestArgs = do Nothing -> Nothing configArgs = map ("-e " ++) (testConfigs args) - pure $ testOnlyArg ++ catMaybes [skipPerfArg, summaryArg, junitArg] ++ configArgs + pure $ testOnlyArg + ++ speedArg + ++ catMaybes [skipPerfArg, summaryArg, junitArg] + ++ configArgs + +-- | Set speed for test +setTestSpeed :: TestSpeed -> String +setTestSpeed Fast = "2" +setTestSpeed Average = "1" +setTestSpeed Slow = "0" + From cf67794f469d74c247de9aa5db11df4de57a12b7 Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Sat, 2 Jun 2018 16:28:27 +0530 Subject: [PATCH 05/12] Fixed minor bug with testConfigs Removed indentation error --- src/Settings/Builders/RunTest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index b48ab3ba83..e8099f4560 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -110,7 +110,7 @@ getTestArgs = do 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] pure $ testOnlyArg ++ speedArg From b98524fac21258e6fc6d27fb934498a25e102ab1 Mon Sep 17 00:00:00 2001 From: chitrak7 Date: Sun, 3 Jun 2018 00:28:50 +0530 Subject: [PATCH 06/12] Added support for more testing features --- src/CommandLine.hs | 73 +++++++++++++++++++++++--------- src/Settings/Builders/RunTest.hs | 15 ++++++- 2 files changed, 66 insertions(+), 22 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 8e9f283cc1..c99cd60f49 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -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 } @@ -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 } } @@ -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 = @@ -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) diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index e8099f4560..407c9df1e3 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -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 @@ -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 From d06ef68713e0db4705de6c39547b9fb2cfeacdf3 Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 5 Jun 2018 00:52:30 +0530 Subject: [PATCH 07/12] Rectified Merge Errors --- src/GHC.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 30cec78d9c..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, checkApiAnnotations, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, - filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, + 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, process, rts, runGhc, stm, - templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, - win32, xhtml, ghcPackages, isGhcPackage, defaultPackages, testsuitePackages, + 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, @@ -140,7 +141,7 @@ programPath context@Context {..} = do -- which is likely just a historical accident that will hopefully be fixed. -- See: https://github.com/snowleopard/hadrian/issues/570 -- Likewise for 'unlit'. - path <- if package `elem` [touchy, unlit, iservBin] + path <- if package `elem` [touchy, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage pgm <- programName context From 5961be4f703e7198a667c0533ec4d20d41adc8b8 Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 12 Jun 2018 20:45:06 +0530 Subject: [PATCH 08/12] Removed need rule for Hp2ps --- src/Rules/Test.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 85c5e22316..fec8e9df96 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -79,7 +79,6 @@ needTestBuilders :: Action () needTestBuilders = do needBuilder $ Ghc CompileHs Stage2 needBuilder $ GhcPkg Update Stage1 - needBuilder Hp2Ps needBuilder Hpc needBuilder (Hsc2Hs Stage1) needTestsuiteBuilders From 29a6a0d6ce57f8512683f740c25ff138168fba44 Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 12 Jun 2018 21:30:21 +0530 Subject: [PATCH 09/12] using all available threads --- src/Settings/Builders/Make.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index 9058eed948..8dcd0960c8 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -24,9 +24,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do compiler <- expr $ fullpath ghc checkPpr <- expr $ fullpath checkPpr checkApiAnnotations <- expr $ fullpath checkApiAnnotations - let t = show $ max 4 (threads - 2) return [ "fast" - , "THREADS=" ++ t + , "THREADS=" ++ threads , "TEST_HC=" ++ (top -/- compiler) , "CHECK_PPR=" ++ (top -/- checkPpr) , "CHECK_API_ANNOTATIONS=" ++ (top -/- checkApiAnnotations) From d886a74aeb345a961d47c89527106a7db96388f1 Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 12 Jun 2018 22:09:05 +0530 Subject: [PATCH 10/12] Minor Revision --- src/CommandLine.hs | 11 +++++++---- src/Hadrian/Utilities.hs | 6 ------ src/Rules/Test.hs | 3 +-- src/Settings/Builders/Make.hs | 2 +- src/Settings/Builders/RunTest.hs | 2 +- 5 files changed, 10 insertions(+), 14 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index c99cd60f49..d15dd6fe92 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 @@ -161,8 +164,8 @@ readTestThreads thread = Right $ \flags -> flags { testArgs = (testArgs flags) { 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 = +readTestWay :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) +readTestWay ways = case ways of Nothing -> Right id Just way -> Right $ \flags -> @@ -208,7 +211,7 @@ optDescrs = "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") + , Option [] ["test-way"] (OptArg readTestWay "TEST_WAY") "only run these ways" ] -- | A type-indexed map containing Hadrian command line arguments to be passed diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index c589660655..7bc1284070 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -31,9 +31,6 @@ module Hadrian.Utilities ( -- * Useful re-exports Dynamic, fromDynamic, toDyn, TypeRep, typeOf, - - -- * Testsuite Settings - TestSpeed (..) ) where import Control.Monad.Extra @@ -484,6 +481,3 @@ renderUnicorn ls = ponyPadding = " " boxLines :: [String] boxLines = ["", "", ""] ++ (lines . renderBox $ ls) - -data TestSpeed = Slow | Average | Fast deriving (Show, Eq) - diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index fec8e9df96..dac2b2a275 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -71,8 +71,7 @@ needTestsuiteBuilders = do need targets where needfile :: Stage -> Package -> Action FilePath - needfile stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg vanilla) - | otherwise = programPath =<< programContext stage pkg + needfile stage pkg = programPath =<< programContext stage pkg needTestBuilders :: Action () diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index 8dcd0960c8..6f8768de1f 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -25,7 +25,7 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do checkPpr <- expr $ fullpath checkPpr checkApiAnnotations <- expr $ fullpath checkApiAnnotations return [ "fast" - , "THREADS=" ++ threads + , "THREADS=" ++ show threads , "TEST_HC=" ++ (top -/- compiler) , "CHECK_PPR=" ++ (top -/- checkPpr) , "CHECK_API_ANNOTATIONS=" ++ (top -/- checkApiAnnotations) diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 407c9df1e3..a30058f0f3 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -1,6 +1,6 @@ module Settings.Builders.RunTest (runTestBuilderArgs) where -import CommandLine (TestArgs(..), defaultTestArgs) +import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..)) import Flavour import GHC.Packages import Hadrian.Builder (getBuilderPath) From cf9a4430f33013c8ae36258a888b1dca0157fa7c Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 12 Jun 2018 22:33:53 +0530 Subject: [PATCH 11/12] Removed TestThread argument --- src/CommandLine.hs | 7 ------- src/Settings/Builders/RunTest.hs | 5 +---- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index d15dd6fe92..b86b448d62 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -52,7 +52,6 @@ data TestArgs = TestArgs , testSkipPerf :: Bool , testSpeed :: TestSpeed , testSummary :: Maybe FilePath - , testThreads :: Maybe String , testVerbosity:: Maybe String , testWays :: [String] } deriving (Eq, Show) @@ -67,7 +66,6 @@ defaultTestArgs = TestArgs , testSkipPerf = False , testSpeed = Average , testSummary = Nothing - , testThreads = Nothing , testVerbosity= Nothing , testWays = [] } @@ -158,9 +156,6 @@ readTestSpeed ms = readTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestSummary 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 } } - readTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestVerbose verbose = Right $ \flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } } @@ -207,8 +202,6 @@ optDescrs = "fast, slow or normal. Normal by default" , Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY") "Where to output the test summary file." - , 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 readTestWay "TEST_WAY") diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index a30058f0f3..6e1c5d1b59 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -114,9 +114,6 @@ 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 @@ -124,7 +121,7 @@ getTestArgs = do pure $ testOnlyArg ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg - , junitArg, threadArg, verbosityArg ] + , junitArg, verbosityArg ] ++ configArgs ++ wayArgs From 71d87c8f4be08ee123345bfb5717202937cdcb3a Mon Sep 17 00:00:00 2001 From: Chitrak Raj Gupta Date: Tue, 12 Jun 2018 23:41:00 +0530 Subject: [PATCH 12/12] Update Utilities.hs --- src/Hadrian/Utilities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index 7bc1284070..4ef0970b59 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -30,7 +30,7 @@ module Hadrian.Utilities ( (<&>), (%%>), cmdLineLengthLimit, -- * Useful re-exports - Dynamic, fromDynamic, toDyn, TypeRep, typeOf, + Dynamic, fromDynamic, toDyn, TypeRep, typeOf ) where import Control.Monad.Extra