diff options
author | Zubin Duggal <zubin.duggal@gmail.com> | 2021-10-04 15:58:39 +0530 |
---|---|---|
committer | Zubin Duggal <zubin.duggal@gmail.com> | 2021-10-13 13:51:03 +0530 |
commit | 8c224b6d43e220930ef0a60e50636e4910d15229 (patch) | |
tree | 99459405e1e362bc04b9710917320e72724624f1 /hadrian/src | |
parent | 337a31db4a6985e70ea1d852f4eb7e5d3f929c9b (diff) | |
download | haskell-8c224b6d43e220930ef0a60e50636e4910d15229.tar.gz |
ci: test in-tree compiler in hadrian
Diffstat (limited to 'hadrian/src')
-rw-r--r-- | hadrian/src/Builder.hs | 9 | ||||
-rw-r--r-- | hadrian/src/CommandLine.hs | 16 | ||||
-rw-r--r-- | hadrian/src/Oracles/TestSettings.hs | 7 | ||||
-rw-r--r-- | hadrian/src/Rules/Test.hs | 37 | ||||
-rw-r--r-- | hadrian/src/Settings/Builders/RunTest.hs | 10 |
5 files changed, 46 insertions, 33 deletions
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index bd8cd95040..975d33cbff 100644 --- a/hadrian/src/Builder.hs +++ b/hadrian/src/Builder.hs @@ -253,11 +253,10 @@ instance H.Builder Builder where 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 + withResources buildResources $ + withTempFile $ \temp -> do + () <- cmd' [path] (buildArgs ++ ["--only-report-hadrian-deps", temp]) + readFile' temp _ -> error $ "Builder " ++ show builder ++ " can not be asked!" runBuilderWith :: Builder -> BuildInfo -> Action () diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs index 2c5b90c499..2bee0e44e9 100644 --- a/hadrian/src/CommandLine.hs +++ b/hadrian/src/CommandLine.hs @@ -71,7 +71,13 @@ data TestArgs = TestArgs , testVerbosity :: Maybe String , testWays :: [String] , brokenTests :: [String] - , testAccept :: Bool} + , testAccept :: Bool + , testHasInTreeFiles :: Bool + -- ^ This is used to signal that we have access to in-tree files like + -- the rts sources and the haddock stats directory even if the test + -- compiler is not in-tree + -- If this flag is set, then those tests will also be run. + } deriving (Eq, Show) -- | Default value for `TestArgs`. @@ -92,7 +98,9 @@ defaultTestArgs = TestArgs , testVerbosity = Nothing , testWays = [] , brokenTests = [] - , testAccept = False } + , testAccept = False + , testHasInTreeFiles = False + } readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually" @@ -140,6 +148,9 @@ readTestKeepFiles = Right $ \flags -> flags { testArgs = (testArgs flags) { test readTestAccept :: Either String (CommandLineArgs -> CommandLineArgs) readTestAccept = Right $ \flags -> flags { testArgs = (testArgs flags) { testAccept = True } } +readTestHasInTreeFiles :: Either String (CommandLineArgs -> CommandLineArgs) +readTestHasInTreeFiles = Right $ \flags -> flags { testArgs = (testArgs flags) { testHasInTreeFiles = True } } + readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler where @@ -298,6 +309,7 @@ optDescrs = , Option [] ["broken-test"] (OptArg readBrokenTests "TEST_NAME") "consider these tests to be broken" , Option ['a'] ["test-accept"] (NoArg readTestAccept) "Accept new output of tests" + , Option [] ["test-have-intree-files"] (NoArg readTestHasInTreeFiles) "Run the in-tree tests even with an out of tree compiler" , Option [] ["prefix"] (OptArg readPrefix "PATH") "Destination path for the bindist 'install' rule" , Option [] ["complete-setting"] (OptArg readCompleteStg "SETTING") diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs index 6b08a43cd5..116bf95789 100644 --- a/hadrian/src/Oracles/TestSettings.hs +++ b/hadrian/src/Oracles/TestSettings.hs @@ -4,7 +4,7 @@ module Oracles.TestSettings ( TestSetting (..), testSetting, testRTSSettings - , getCompilerPath, getBinaryDirectory + , getCompilerPath, getBinaryDirectory, isInTreeCompiler ) where import Base @@ -81,6 +81,7 @@ getBinaryDirectory :: String -> Action FilePath getBinaryDirectory "stage0" = takeDirectory <$> setting SystemGhc getBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0) getBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1) +getBinaryDirectory "stage3" = liftM2 (-/-) topDirectory (stageBinPath Stage2) getBinaryDirectory compiler = pure $ takeDirectory compiler -- | Get the path to the given @--test-compiler@. @@ -88,8 +89,12 @@ getCompilerPath :: String -> Action FilePath getCompilerPath "stage0" = setting SystemGhc getCompilerPath "stage1" = liftM2 (-/-) topDirectory (fullPath Stage0 ghc) getCompilerPath "stage2" = liftM2 (-/-) topDirectory (fullPath Stage1 ghc) +getCompilerPath "stage3" = liftM2 (-/-) topDirectory (fullPath Stage2 ghc) getCompilerPath compiler = pure compiler +isInTreeCompiler :: String -> Bool +isInTreeCompiler c = c `elem` ["stage1","stage2","stage3"] + -- | Get the full path to the given program. fullPath :: Stage -> Package -> Action FilePath fullPath stage pkg = programPath =<< programContext stage pkg diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index 0088765714..31d9427513 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -121,7 +121,9 @@ testRules = do need [root -/- ghcConfigPath, root -/- timeoutPath] args <- userSetting defaultTestArgs - ghcPath <- getCompilerPath (testCompiler args) + + let testCompilerArg = testCompiler args + ghcPath <- getCompilerPath testCompilerArg -- TODO This approach doesn't work. -- Set environment variables for test's Makefile. @@ -172,12 +174,13 @@ testRules = do 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 + when (isInTreeCompiler testCompilerArg) $ do + -- 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 @@ -205,21 +208,21 @@ timeoutProgBuilder = do needTestBuilders :: Action () needTestBuilders = do testGhc <- testCompiler <$> userSetting defaultTestArgs - when (testGhc `elem` ["stage1", "stage2", "stage3"]) + when (isInTreeCompiler testGhc) (needTestsuitePackages testGhc) -- | Build extra programs and libraries required by testsuite +-- 'testGhc' has to be one of "stage1", "stage2" or "stage3" needTestsuitePackages :: String -> Action () needTestsuitePackages testGhc = do - when (testGhc `elem` ["stage1", "stage2", "stage3"]) $ do - let stg = stageOf testGhc - allpkgs <- packages <$> flavour - stgpkgs <- allpkgs (succ stg) - testpkgs <- testsuitePackages - let pkgs = filter (\p -> not $ "iserv" `isInfixOf` pkgName p) - (stgpkgs ++ testpkgs) - need =<< mapM (pkgFile stg) pkgs - needIservBins + let stg = stageOf testGhc + allpkgs <- packages <$> flavour + stgpkgs <- allpkgs (succ stg) + testpkgs <- testsuitePackages + let pkgs = filter (\p -> not $ "iserv" `isInfixOf` pkgName p) + (stgpkgs ++ testpkgs) + need =<< mapM (pkgFile stg) pkgs + needIservBins -- stage 1 ghc lives under stage0/bin, -- stage 2 ghc lives under stage1/bin, etc diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs index d1bd7b1e0b..c994a7b018 100644 --- a/hadrian/src/Settings/Builders/RunTest.hs +++ b/hadrian/src/Settings/Builders/RunTest.hs @@ -53,13 +53,7 @@ runTestGhcFlags = do -- Command line arguments for invoking the @runtest.py@ script. A lot of this -- mirrors @testsuite/mk/test.mk@. runTestBuilderArgs :: Args -runTestBuilderArgs = - mconcat [ runTestNormalArgs - , builder (Testsuite GetExtraDeps) ? arg "--only-report-hadrian-deps" - ] - -runTestNormalArgs :: Args -runTestNormalArgs = builder Testsuite ? do +runTestBuilderArgs = builder Testsuite ? do pkgs <- expr $ stagePackages Stage1 libTests <- expr $ filterM doesDirectoryExist $ concat [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ] @@ -213,7 +207,7 @@ getTestArgs = do hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps" <.> exe)] hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc" <.> exe)] inTreeArg = [ "-e", "config.in_tree_compiler=" ++ - show (testCompiler args `elem` ["stage1", "stage2", "stage3"]) ] + show (isInTreeCompiler (testCompiler args) || testHasInTreeFiles args) ] pure $ configFileArg ++ testOnlyArg ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg |