diff options
author | Zubin Duggal <zubin.duggal@gmail.com> | 2021-08-03 13:50:18 +0530 |
---|---|---|
committer | Zubin Duggal <zubin.duggal@gmail.com> | 2021-10-13 13:51:00 +0530 |
commit | 4536e8ca27e2173af9bc72e2e5992be140ecb2d2 (patch) | |
tree | 5cb1b99d618fca8dbc91277102a48036af9595b2 /hadrian | |
parent | 58bd0cc1e6dc95328879fc53e9c58b7079d4c292 (diff) | |
download | haskell-4536e8ca27e2173af9bc72e2e5992be140ecb2d2.tar.gz |
hadrian, testsuite: Teach Hadrian to query the testsuite driver for dependencies
Issues #19072, #17728, #20176
Diffstat (limited to 'hadrian')
-rw-r--r-- | hadrian/src/Builder.hs | 27 | ||||
-rw-r--r-- | hadrian/src/Expression.hs | 7 | ||||
-rw-r--r-- | hadrian/src/Flavour.hs | 4 | ||||
-rw-r--r-- | hadrian/src/Rules/Test.hs | 12 | ||||
-rw-r--r-- | hadrian/src/Settings/Builders/RunTest.hs | 30 |
5 files changed, 60 insertions, 20 deletions
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index c746f95695..bd8cd95040 100644 --- a/hadrian/src/Builder.hs +++ b/hadrian/src/Builder.hs @@ -2,7 +2,7 @@ module Builder ( -- * Data types ArMode (..), CcMode (..), ConfigurationInfo (..), DependencyType (..), - GhcMode (..), GhcPkgMode (..), HaddockMode (..), SphinxMode (..), + GhcMode (..), GhcPkgMode (..), HaddockMode (..), TestMode(..), SphinxMode (..), TarMode (..), Builder (..), -- * Builder properties @@ -114,6 +114,15 @@ instance Binary HaddockMode instance Hashable HaddockMode instance NFData HaddockMode +-- | The testsuite driver can be called in two different modes: +-- * Actually run the tests +-- * Get all the hadrian targets needed for the current test configuration +data TestMode = RunTest | GetExtraDeps deriving (Eq, Generic, Show) + +instance Binary TestMode +instance Hashable TestMode +instance NFData TestMode + -- | A 'Builder' is a (usually external) command invoked in a separate process -- via 'cmd'. Here are some examples: -- * 'Alex' is a lexical analyser generator that builds @Lexer.hs@ from @Lexer.x@. @@ -148,7 +157,7 @@ data Builder = Alex | Patch | Python | Ranlib - | RunTest + | Testsuite TestMode | Sphinx SphinxMode | Tar TarMode | Unlit @@ -225,7 +234,8 @@ instance H.Builder Builder where -- contrast this with runBuilderWith, which returns @Action ()@ -- this returns the @stdout@ from running the builder. -- For now this only implements asking @ghc-pkg@ about package - -- dependencies. + -- dependencies and asking the testsuite driver about hadrian + -- dependencies for tests. askBuilderWith :: Builder -> BuildInfo -> Action String askBuilderWith builder BuildInfo {..} = case builder of GhcPkg Dependencies _ -> do @@ -241,6 +251,13 @@ instance H.Builder Builder where need [path] Stdout stdout <- cmd' [path] ["--no-user-package-db", "field", input, "depends"] return stdout + Testsuite GetExtraDeps -> do + path <- builderPath builder + withResources buildResources $ do + -- The testsuite driver reports the dependencies on stderr + -- buildArgs should include --only-report-hadrian-deps at this point + Stderr stderr <- cmd' [path] buildArgs + return stderr _ -> error $ "Builder " ++ show builder ++ " can not be asked!" runBuilderWith :: Builder -> BuildInfo -> Action () @@ -322,7 +339,7 @@ instance H.Builder Builder where -- RunTest produces a very large amount of (colorised) output; -- Don't attempt to capture it. - RunTest -> do + Testsuite RunTest -> do Exit code <- cmd echo [path] buildArgs when (code /= ExitSuccess) $ do fail "tests failed" @@ -371,7 +388,7 @@ systemBuilderPath builder = case builder of Patch -> fromKey "patch" Python -> fromKey "python" Ranlib -> fromKey "ranlib" - RunTest -> fromKey "python" + Testsuite _ -> fromKey "python" Sphinx _ -> fromKey "sphinx-build" Tar _ -> fromKey "tar" Xelatex -> fromKey "xelatex" diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs index 710986b749..62e83ccecb 100644 --- a/hadrian/src/Expression.hs +++ b/hadrian/src/Expression.hs @@ -86,6 +86,13 @@ instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where Configure path -> builder (f path) _ -> return False +instance BuilderPredicate a => BuilderPredicate (TestMode -> a) where + builder f = do + b <- getBuilder + case b of + Testsuite mode -> builder (f mode) + _ -> return False + -- | Is the current build 'Way' equal to a certain value? way :: Way -> Predicate way w = (w ==) <$> getWay diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs index 3a23fd878f..d555246c4b 100644 --- a/hadrian/src/Flavour.hs +++ b/hadrian/src/Flavour.hs @@ -151,7 +151,7 @@ enableThreadSanitizer = addArgs $ mconcat , builder (Ghc LinkHs) ? arg "-optl-fsanitize=thread" , builder (Cc CompileC) ? (arg "-fsanitize=thread" <> arg "-DTSAN_ENABLED") , builder (Cabal Flags) ? arg "thread-sanitizer" - , builder RunTest ? arg "--config=have_thread_sanitizer=True" + , builder Testsuite ? arg "--config=have_thread_sanitizer=True" ] -- | Use the LLVM backend in stages 1 and later. @@ -338,7 +338,7 @@ builderPredicate = builderSetting <&> (\(wstg, wpkg, builderMode) -> BM_Ghc ghcMode -> wildcard (builder Ghc) (builder . Ghc) ghcMode BM_Cc ccMode -> wildcard (builder Cc) (builder . Cc) ccMode BM_CabalConfigure -> builder (Cabal Setup) - BM_RunTest -> builder RunTest + BM_RunTest -> builder Testsuite ) ) diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index 7e19798b10..0088765714 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -170,11 +170,19 @@ testRules = do -- which is in turn included by all test 'Makefile's. setEnv "ghc_config_mk" (top -/- root -/- ghcConfigPath) + let test_target tt = target (vanillaContext Stage2 compiler) (Testsuite tt) [] [] + + -- We need to ask the testsuite if it needs any extra hadrian dependencies for the + -- tests it is going to run, + -- for example "docs_haddock" + -- We then need to go and build these dependencies + extra_targets <- words <$> askWithResources [] (test_target GetExtraDeps) + need extra_targets + -- Execute the test target. -- We override the verbosity setting to make sure the user can see -- the test output: https://gitlab.haskell.org/ghc/ghc/issues/15951. - withVerbosity Diagnostic $ buildWithCmdOptions env $ - target (vanillaContext Stage2 compiler) RunTest [] [] + withVerbosity Diagnostic $ buildWithCmdOptions env $ test_target RunTest -- | Build the timeout program. -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23 diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs index 3c918a28f7..d1bd7b1e0b 100644 --- a/hadrian/src/Settings/Builders/RunTest.hs +++ b/hadrian/src/Settings/Builders/RunTest.hs @@ -7,6 +7,8 @@ import CommandLine import Oracles.TestSettings import Packages import Settings.Builders.Common +import qualified Data.Set as Set +import Flavour getTestSetting :: TestSetting -> Expr String getTestSetting key = expr $ testSetting key @@ -51,7 +53,13 @@ runTestGhcFlags = do -- Command line arguments for invoking the @runtest.py@ script. A lot of this -- mirrors @testsuite/mk/test.mk@. runTestBuilderArgs :: Args -runTestBuilderArgs = builder RunTest ? do +runTestBuilderArgs = + mconcat [ runTestNormalArgs + , builder (Testsuite GetExtraDeps) ? arg "--only-report-hadrian-deps" + ] + +runTestNormalArgs :: Args +runTestNormalArgs = builder Testsuite ? do pkgs <- expr $ stagePackages Stage1 libTests <- expr $ filterM doesDirectoryExist $ concat [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ] @@ -159,7 +167,13 @@ getTestArgs = do bindir <- expr $ getBinaryDirectory (testCompiler args) compiler <- expr $ getCompilerPath (testCompiler args) globalVerbosity <- shakeVerbosity <$> expr getShakeOptions - haveDocs <- areDocsPresent + -- the testsuite driver will itself tell us if we need to generate the docs target + -- So we always pass the haddock path if the hadrian configuration allows us to build + -- docs + -- If the configuration doesn't allow us to build docs, then we don't pass the haddock + -- option, and the testsuite driver will not subsequently ask us to build haddocks + -- for the required tests + haveDocs <- willDocsBeBuilt let configFileArg= ["--config-file=" ++ (testConfigFile args)] testOnlyArg = map ("--only=" ++) (testOnly args ++ testEnvTargets) onlyPerfArg = if testOnlyPerf args @@ -208,16 +222,10 @@ getTestArgs = do ++ haddockArg ++ hp2psArg ++ hpcArg ++ inTreeArg ++ brokenTestArgs - where areDocsPresent = expr $ do - root <- buildRoot - and <$> traverse doesFileExist (docFiles root) + where willDocsBeBuilt = expr $ do + doctargets <- ghcDocs =<< flavour + pure $ Haddocks `Set.member` doctargets - docFiles root = - [ root -/- "docs" -/- "html" -/- "libraries" -/- p -/- (p ++ ".haddock") - -- list of packages from - -- utils/haddock/haddock-test/src/Test/Haddock/Config.hs - | p <- [ "array", "base", "ghc-prim", "process", "template-haskell" ] - ] -- | Set speed for test setTestSpeed :: TestSpeed -> String |