Hadrian: various improvements around the 'test' rule

- introduce a -k/--keep-test-files flag to prevent cleanup
- add -dstg-lint to the options that are always passed to tests
- infer library ways from the compiler to be tested instead of getting them
  from the flavour (like make)
- likewise for figuring out whether the compiler to be tested is "debugged"
- specify config.exeext
- correctly specify config.in_tree_compiler, instead of always passing True
- fix formatting of how we pass a few test options
- add (potential) extensions to check-* program names
- build check-* programs with the compiler to be tested
- set TEST_HC_OPTS_INTERACTIVE and PYTHON env vars when running tests

6 files changed, 218 insertions, 106 deletions

diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index 75e981222a..9c9cf9f5d2 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -15,7 +15,7 @@ import System.Environment
 
 import qualified Data.Set as Set
 
-data TestSpeed = Slow | Average | Fast deriving (Show, Eq)
+data TestSpeed = TestSlow | TestNormal | TestFast deriving (Show, Eq)
 
 -- | All arguments that can be passed to Hadrian via the command line.
 data CommandLineArgs = CommandLineArgs
@@ -45,7 +45,8 @@ defaultCommandLineArgs = CommandLineArgs
 
 -- | These arguments are used by the `test` target.
 data TestArgs = TestArgs
-    { testCompiler   :: String
+    { testKeepFiles  :: Bool
+    , testCompiler   :: String
     , testConfigFile :: String
     , testConfigs    :: [String]
     , testJUnit      :: Maybe FilePath
@@ -61,14 +62,15 @@ data TestArgs = TestArgs
 -- | Default value for `TestArgs`.
 defaultTestArgs :: TestArgs
 defaultTestArgs = TestArgs
-    { testCompiler   = "stage2"
+    { testKeepFiles  = False
+    , testCompiler   = "stage2"
     , testConfigFile = "testsuite/config/ghc"
     , testConfigs    = []
     , testJUnit      = Nothing
     , testOnly       = []
     , testOnlyPerf   = False
     , testSkipPerf   = False
-    , testSpeed      = Fast
+    , testSpeed      = TestNormal
     , testSummary    = Nothing
     , testVerbosity  = Nothing
     , testWays       = [] }
@@ -119,6 +121,9 @@ readProgressInfo ms =
     set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { progressInfo = flag }
 
+readTestKeepFiles :: Either String (CommandLineArgs -> CommandLineArgs)
+readTestKeepFiles = Right $ \flags -> flags { testArgs = (testArgs flags) { testKeepFiles = True } }
+
 readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler
   where
@@ -158,9 +163,9 @@ 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 "fast"    = Just TestFast
+    go "slow"    = Just TestSlow
+    go "normal"  = Just TestNormal
     go _         = Nothing
     set :: TestSpeed -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }
@@ -217,6 +222,8 @@ optDescrs =
       "Progress info style (None, Brief, Normal or Unicorn)."
     , Option [] ["docs"] (OptArg readDocsArg "TARGET")
       "Strip down docs targets (none, no-haddocks, no-sphinx[-{html, pdfs, man}]."
+    , Option ['k'] ["keep-test-files"] (NoArg readTestKeepFiles)
+      "Keep all the files generated when running the testsuite."
     , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER")
       "Use given compiler [Default=stage2]."
     , Option [] ["test-config-file"] (OptArg readTestConfigFile "CONFIG_FILE")
diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs
index 1bf75b527d..9d93e10cf4 100644
--- a/hadrian/src/Oracles/TestSettings.hs
+++ b/hadrian/src/Oracles/TestSettings.hs
@@ -2,10 +2,16 @@
 -- | compiler. We need to search this file for required keys and setting
 -- | required for testsuite e.g. WORDSIZE, HOSTOS etc.
 
-module Oracles.TestSettings (TestSetting (..), testSetting, testRTSSettings) where
+module Oracles.TestSettings
+  ( TestSetting (..), testSetting, testRTSSettings
+  , getCompilerPath, getBinaryDirectory
+  ) where
 
 import Base
 import Hadrian.Oracles.TextFile
+import Oracles.Setting (topDirectory, setting, Setting(..))
+import Settings (programContext)
+import Packages
 
 testConfigFile :: Action FilePath
 testConfigFile = buildRoot <&> (-/- "test/ghcconfig")
@@ -67,3 +73,23 @@ testRTSSettings :: Action [String]
 testRTSSettings = do
     file <- testConfigFile
     words <$> lookupValueOrError file "GhcRTSWays"
+
+-- | Directory to look for binaries.
+--   We assume that required programs are present in the same binary directory
+--   in which ghc is stored and that they have their conventional name.
+getBinaryDirectory :: String -> Action FilePath
+getBinaryDirectory "stage0" = takeDirectory <$> setting SystemGhc
+getBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
+getBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
+getBinaryDirectory compiler = pure $ takeDirectory compiler
+
+-- | Get the path to the given @--test-compiler@.
+getCompilerPath :: String -> Action FilePath
+getCompilerPath "stage0" = setting SystemGhc
+getCompilerPath "stage1" = liftM2 (-/-) topDirectory (fullPath Stage0 ghc)
+getCompilerPath "stage2" = liftM2 (-/-) topDirectory (fullPath Stage1 ghc)
+getCompilerPath compiler = pure compiler
+
+-- | 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 b72c1b964b..55ef19a57b 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -3,8 +3,11 @@ module Rules.Test (testRules) where
 import System.Environment
 
 import Base
+import CommandLine
 import Expression
+import Flavour
 import Oracles.Setting
+import Oracles.TestSettings
 import Packages
 import Settings
 import Settings.Default
@@ -16,7 +19,21 @@ ghcConfigHsPath :: FilePath
 ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
 
 ghcConfigProgPath :: FilePath
-ghcConfigProgPath = "test/bin/ghc-config"
+ghcConfigProgPath = "test/bin/ghc-config" <.> exe
+
+checkPprProgPath, checkPprSourcePath :: FilePath
+checkPprProgPath = "test/bin/check-ppr" <.> exe
+checkPprSourcePath = "utils/check-ppr/Main.hs"
+
+checkApiAnnotationsProgPath, checkApiAnnotationsSourcePath :: FilePath
+checkApiAnnotationsProgPath = "test/bin/check-api-annotations" <.> exe
+checkApiAnnotationsSourcePath = "utils/check-api-annotations/Main.hs"
+
+checkPrograms :: [(FilePath, FilePath)]
+checkPrograms =
+    [ (checkPprProgPath, checkPprSourcePath)
+    , (checkApiAnnotationsProgPath, checkApiAnnotationsSourcePath)
+    ]
 
 ghcConfigPath :: FilePath
 ghcConfigPath = "test/ghcconfig"
@@ -27,23 +44,35 @@ testRules = do
     root <- buildRootRules
 
     -- Using program shipped with testsuite to generate ghcconfig file.
-    root -/- ghcConfigProgPath ~> do
-        ghc <- builderPath $ Ghc CompileHs Stage0
-        createDirectory $ takeDirectory (root -/- ghcConfigProgPath)
-        cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
-
-    -- TODO : Use input test compiler and not just stage2 compiler.
-    root -/- ghcConfigPath ~> do
-        ghcPath <- needFile Stage1 ghc
+    root -/- ghcConfigProgPath %> \_ -> do
+        ghc0Path <- (<.> exe) <$> getCompilerPath "stage0"
+        cmd [ghc0Path] [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
+
+    -- Rules for building check-ppr and check-ppr-annotations with the compiler
+    -- we are going to test (in-tree or out-of-tree).
+    forM_ checkPrograms $ \(progPath, sourcePath) ->
+        root -/- progPath %> \path -> do
+            testGhc <- testCompiler <$> userSetting defaultTestArgs
+            top <- topDirectory
+            when (testGhc `elem` ["stage1", "stage2", "stage3"]) $ do
+                let stg = stageOf testGhc
+                need . (:[]) =<< programPath (Context stg ghc vanilla)
+            bindir <- getBinaryDirectory testGhc
+            cmd [bindir </> "ghc" <.> exe]
+                ["-package", "ghc", "-o", top -/- path, top -/- sourcePath]
+
+    root -/- ghcConfigPath %> \_ -> do
+        args <- userSetting defaultTestArgs
+        let testGhc = testCompiler args
+            stg = stageOf testGhc
+        ghcPath <- getCompilerPath testGhc
+        when (testGhc `elem` ["stage1", "stage2", "stage3"]) $
+            need . (:[]) =<< programPath (Context stg ghc vanilla)
         need [root -/- ghcConfigProgPath]
         cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
             [ghcPath]
 
-    root -/- timeoutPath ~> timeoutProgBuilder
-
-    "validate" ~> do
-        needTestBuilders
-        build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
+    root -/- timeoutPath %> \_ -> timeoutProgBuilder
 
     "test" ~> do
         needTestBuilders
@@ -52,6 +81,9 @@ testRules = do
         -- Prepare Ghc configuration file for input compiler.
         need [root -/- ghcConfigPath, root -/- timeoutPath]
 
+        args <- userSetting defaultTestArgs
+        ghcPath <- getCompilerPath (testCompiler args)
+
         -- TODO This approach doesn't work.
         -- Set environment variables for test's Makefile.
         env <- sequence
@@ -61,18 +93,28 @@ testRules = do
 
         makePath        <- builderPath $ Make ""
         top             <- topDirectory
-        ghcPath         <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
         ghcFlags        <- runTestGhcFlags
-        checkPprPath    <- (top -/-) <$> needFile Stage1 checkPpr
-        annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations
+        let ghciFlags = ghcFlags ++ unwords
+              [ "--interactive", "-v0", "-ignore-dot-ghci"
+              , "-fno-ghci-history"
+              ]
+
+        pythonPath      <- builderPath Python
+        need [ root -/- checkPprProgPath, root -/- checkApiAnnotationsProgPath ]
 
         -- Set environment variables for test's Makefile.
+        -- TODO: Ideally we would define all those env vars in 'env', so that
+        --       Shake can keep track of them, but it is not as easy as it seems
+        --       to get that to work.
         liftIO $ do
             setEnv "MAKE" makePath
+            setEnv "PYTHON" pythonPath
             setEnv "TEST_HC" ghcPath
             setEnv "TEST_HC_OPTS" ghcFlags
-            setEnv "CHECK_PPR" checkPprPath
-            setEnv "CHECK_API_ANNOTATIONS" annotationsPath
+            setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags
+            setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
+            setEnv "CHECK_API_ANNOTATIONS"
+                   (top -/- root -/- checkApiAnnotationsProgPath)
 
         -- Execute the test target.
         -- We override the verbosity setting to make sure the user can see
@@ -80,15 +122,6 @@ testRules = do
         withVerbosity Loud $ buildWithCmdOptions env $
             target (vanillaContext Stage2 compiler) RunTest [] []
 
--- | Build extra programs and libraries required by testsuite
-needTestsuitePackages :: Action ()
-needTestsuitePackages = do
-    targets   <- mapM (needFile Stage1) =<< testsuitePackages
-    -- iserv is not supported under Windows
-    windows <- windowsHost
-    when (not windows) needIservBins
-    need targets
-
 -- | Build the timeout program.
 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
 timeoutProgBuilder :: Action ()
@@ -108,27 +141,47 @@ timeoutProgBuilder = do
             writeFile' (root -/- timeoutPath) script
             makeExecutable (root -/- timeoutPath)
 
-needIservBins :: Action ()
-needIservBins = do
-    rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
-    need =<< traverse programPath
-               [ Context Stage1 iserv w
-               | w <- [vanilla, profiling, dynamic]
-               , w `elem` rtsways
-               ]
-
 needTestBuilders :: Action ()
 needTestBuilders = do
-    needBuilder $ Ghc CompileHs Stage2
-    needBuilder $ GhcPkg Update Stage1
-    needBuilder Hpc
-    needBuilder $ Hsc2Hs Stage1
-    needTestsuitePackages
+    testGhc <- testCompiler <$> userSetting defaultTestArgs
+    when (testGhc `elem` ["stage1", "stage2", "stage3"]) needTestsuitePackages
+
+-- | Build extra programs and libraries required by testsuite
+needTestsuitePackages :: Action ()
+needTestsuitePackages = do
+    testGhc <- testCompiler <$> userSetting defaultTestArgs
+    when (testGhc `elem` ["stage1", "stage2", "stage3"]) $ do
+        let stg = stageOf testGhc
+        allpkgs   <- packages <$> flavour
+        stgpkgs   <- allpkgs (succ stg)
+        testpkgs  <- testsuitePackages
+        targets <- mapM (needFile stg) (stgpkgs ++ testpkgs)
+        needIservBins
+        need targets
+
+-- stage 1 ghc lives under stage0/bin,
+-- stage 2 ghc lives under stage1/bin, etc
+stageOf :: String -> Stage
+stageOf "stage1" = Stage0
+stageOf "stage2" = Stage1
+stageOf "stage3" = Stage2
+stageOf _ = error "unexpected stage argument"
+
+needIservBins :: Action ()
+needIservBins = do
+    -- iserv is not supported under Windows
+    windows <- windowsHost
+    when (not windows) $ do
+        testGhc <- testCompiler <$> userSetting defaultTestArgs
+        let stg = stageOf testGhc
+        rtsways <- interpretInContext (vanillaContext stg ghc) getRtsWays
+        need =<< traverse programPath
+            [ Context stg iserv w
+            | w <- [vanilla, profiling, dynamic]
+            , w `elem` rtsways
+            ]
 
 needFile :: Stage -> Package -> Action FilePath
 needFile stage pkg
--- TODO (Alp): we might sometimes need more than vanilla!
--- This should therefore depend on what test ways
--- we are going to use, I suppose?
     | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
     | otherwise     = programPath =<< programContext stage pkg
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 0433888279..56bb8e35fb 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -37,6 +37,6 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do
 
 -- | Support for speed of validation
 setTestSpeed :: TestSpeed -> String
-setTestSpeed Fast    = "fasttest"
-setTestSpeed Average = "test"
-setTestSpeed Slow    = "slowtest"
+setTestSpeed TestFast   = "fasttest"
+setTestSpeed TestNormal = "test"
+setTestSpeed TestSlow   = "slowtest"
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 834cacf03d..ae85cf57a8 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -39,7 +39,7 @@ runTestGhcFlags = do
     -- Take flags to send to the Haskell compiler from test.mk.
     -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
     unwords <$> sequence
-        [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
+        [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -rtsopts"
         , pure ghcOpts
         , pure ghcExtraFlags
         , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
@@ -59,18 +59,19 @@ runTestBuilderArgs = builder RunTest ? do
             [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
             | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
 
-    flav    <- expr flavour
+    testGhc <- expr (testCompiler <$> userSetting defaultTestArgs)
     rtsWays <- expr testRTSSettings
-    libWays <- libraryWays flav
+    libWays <- expr (inferLibraryWays testGhc)
     let hasRtsWay w = elem w rtsWays
         hasLibWay w = elem w libWays
-        debugged    = ghcDebugged flav
     hasDynamic          <- getBooleanSetting TestGhcDynamic
     hasDynamicByDefault <- getBooleanSetting TestGhcDynamicByDefault
     withNativeCodeGen   <- getBooleanSetting TestGhcWithNativeCodeGen
     withInterpreter     <- getBooleanSetting TestGhcWithInterpreter
     unregisterised      <- getBooleanSetting TestGhcUnregisterised
     withSMP             <- getBooleanSetting TestGhcWithSMP
+    debugged            <- read <$> getTestSetting TestGhcDebugged
+    keepFiles           <- expr (testKeepFiles <$> userSetting defaultTestArgs)
 
     windows     <- expr windowsHost
     darwin      <- expr osxHost
@@ -94,8 +95,9 @@ runTestBuilderArgs = builder RunTest ? do
             , pure ["--rootdir=" ++ test | test <- libTests]
             , arg "-e", arg $ "windows=" ++ show windows
             , arg "-e", arg $ "darwin=" ++ show darwin
-            , arg "-e", arg $ "config.local=True"
-            , arg "-e", arg $ "config.cleanup=False" -- Don't clean up.
+            , arg "-e", arg $ "config.local=False"
+            , arg "-e", arg $ "config.cleanup=" ++ show (not keepFiles)
+            , arg "-e", arg $ "config.exeext=" ++ quote exe
             , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
             , arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged)
             , arg "-e", arg $ asZeroOne "ghc_with_native_codegen=" withNativeCodeGen
@@ -116,9 +118,6 @@ runTestBuilderArgs = builder RunTest ? do
             , arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic
             , arg "-e", arg $ "config.ghc_built_by_llvm=" ++ show ghcBuiltByLlvm
 
-            -- Use default value, see:
-            -- https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk
-            , arg "-e", arg $ "config.in_tree_compiler=True"
             , arg "-e", arg $ "config.top=" ++ show (top -/- "testsuite")
             , arg "-e", arg $ "config.wordsize=" ++ show wordsize
             , arg "-e", arg $ "config.os="       ++ show os
@@ -137,8 +136,8 @@ getTestArgs = do
     -- targets specified in the TEST env var
     testEnvTargets <- maybe [] words <$> expr (liftIO $ lookupEnv "TEST")
     args            <- expr $ userSetting defaultTestArgs
-    bindir          <- expr $ setBinaryDirectory (testCompiler args)
-    compiler        <- expr $ setCompiler (testCompiler args)
+    bindir          <- expr $ getBinaryDirectory (testCompiler args)
+    compiler        <- expr $ getCompilerPath (testCompiler args)
     globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
     let configFileArg= ["--config-file=" ++ (testConfigFile args)]
         testOnlyArg  =  map ("--only=" ++) (testOnly args ++ testEnvTargets)
@@ -150,10 +149,10 @@ getTestArgs = do
                            else Nothing
         speedArg     = ["-e", "config.speed=" ++ setTestSpeed (testSpeed args)]
         summaryArg   = case testSummary args of
-                           Just filepath -> Just $ "--summary-file" ++ quote filepath
+                           Just filepath -> Just $ "--summary-file " ++ show filepath
                            Nothing -> Just $ "--summary-file=testsuite_summary.txt"
         junitArg     = case testJUnit args of
-                           Just filepath -> Just $ "--junit " ++ quote filepath
+                           Just filepath -> Just $ "--junit=" ++ filepath
                            Nothing -> Nothing
         configArgs   = concat [["-e", configArg] | configArg <- testConfigs args]
         verbosityArg = case testVerbosity args of
@@ -165,46 +164,72 @@ getTestArgs = do
         haddockArg   = ["--config", "haddock=" ++ show (bindir -/- "haddock")]
         hp2psArg     = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")]
         hpcArg       = ["--config", "hpc=" ++ show (bindir -/- "hpc")]
+        inTreeArg    = [ "-e", "config.in_tree_compiler=" ++
+          show (testCompiler args `elem` ["stage1", "stage2", "stage3"]) ]
+
     pure $  configFileArg ++ testOnlyArg ++ speedArg
          ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
                       , junitArg, verbosityArg  ]
          ++ configArgs ++ wayArgs ++  compilerArg ++ ghcPkgArg
-         ++ haddockArg ++ hp2psArg ++ hpcArg
-
--- TODO: Switch to 'Stage' as the first argument instead of 'String'.
--- | Directory to look for Binaries
--- | We assume that required programs are present in the same binary directory
--- | in which ghc is stored and that they have their conventional name.
--- | QUESTION : packages can be named different from their conventional names.
--- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will
--- | be impossible to search the binary. Only possible way will be to take user
--- | inputs for these directory also. boilerplate soes not account for this
--- | problem, but simply returns an error. How should we handle such cases?
-setBinaryDirectory :: String -> Action FilePath
-setBinaryDirectory "stage0" = takeDirectory <$> setting SystemGhc
-setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
-setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
-setBinaryDirectory compiler = pure $ parentPath compiler
-
--- TODO: Switch to 'Stage' as the first argument instead of 'String'.
--- | Set Test Compiler.
-setCompiler :: String -> Action FilePath
-setCompiler "stage0" = setting SystemGhc
-setCompiler "stage1" = liftM2 (-/-) topDirectory (fullPath Stage0 ghc)
-setCompiler "stage2" = liftM2 (-/-) topDirectory (fullPath Stage1 ghc)
-setCompiler compiler = pure compiler
+         ++ haddockArg ++ hp2psArg ++ hpcArg ++ inTreeArg
 
 -- | Set speed for test
 setTestSpeed :: TestSpeed -> String
-setTestSpeed Slow    = "0"
-setTestSpeed Average = "1"
-setTestSpeed Fast    = "2"
-
--- | Returns parent path of test compiler
--- | TODO: Is there a simpler way to find parent directory?
-parentPath :: String -> String
-parentPath path = intercalate "/" $ init $ splitOn "/" path
-
--- | TODO: Move to Hadrian utilities.
-fullPath :: Stage -> Package -> Action FilePath
-fullPath stage pkg = programPath =<< programContext stage pkg
+setTestSpeed TestSlow   = "0"
+setTestSpeed TestNormal = "1"
+setTestSpeed TestFast   = "2"
+
+-- | The purpose of this function is, given a compiler
+--   (stage 1, 2, 3 or an external one), to infer the ways
+--   that the libraries have been built in.
+--
+--   While we have this data readily available for in-tree compilers
+--   that we build (through the 'Flavour'), that is not the case for
+--   out-of-tree compilers that we may want to test, as is the case when
+--   we are running './validate --hadrian' (it packages up a binary
+--   distribution, installs it somewhere near and tests it).
+--
+--   We therefore proceed in a way that works regardless of whether we are
+--   dealing with an in-tree compiler or not: we ask the GHC's install
+--   ghc-pkg to give us the library directory of its @ghc-prim@ package and
+--   look at what ways are available for the interface file of the
+--   @GHC.PrimopWrappers@ module, like the Make build system does in
+--   @testsuite\/mk\/test.mk@ to compute @HAVE_DYNAMIC@, @HAVE_VANILLA@
+--   and @HAVE_PROFILING@:
+--
+--   - if we find @PrimopWrappers.hi@, we have the vanilla way;
+--   - if we find @PrimopWrappers.dyn_hi@, we have the dynamic way;
+--   - if we find @PrimopWrappers.p_hi@, we have the profiling way.
+inferLibraryWays :: String -> Action [Way]
+inferLibraryWays compiler = do
+  bindir <- getBinaryDirectory compiler
+  Stdout ghcPrimLibdirDirty <- cmd
+    [bindir </> "ghc-pkg" <.> exe]
+    ["field", "ghc-prim", "library-dirs", "--simple-output"]
+  let ghcPrimLibdir = fixup ghcPrimLibdirDirty
+  ways <- catMaybes <$> traverse (lookForWay ghcPrimLibdir) candidateWays
+  return ways
+
+  where lookForWay dir (hifile, w) = do
+          exists <- doesFileExist (dir -/- hifile)
+          if exists then return (Just w) else return Nothing
+
+        candidateWays =
+          [ ("GHC/PrimopWrappers.hi", vanilla)
+          , ("GHC/PrimopWrappers.dyn_hi", dynamic)
+          , ("GHC/PrimopWrappers.p_hi", profiling)
+          ]
+
+        -- If the ghc is in a directory with spaces in a path component,
+        -- 'dir' is prefixed and suffixed with double quotes.
+        -- In all cases, there is a \n at the end.
+        -- This function cleans it all up.
+        fixup = removeQuotes . removeNewline
+
+        removeNewline path
+          | "\n" `isSuffixOf` path = init path
+          | otherwise              = path
+
+        removeQuotes path
+          | "\"" `isPrefixOf` path && "\"" `isSuffixOf` path = tail (init path)
+          | otherwise                                        = path
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index b74ee09499..d8008fdaee 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -100,6 +100,7 @@ stage1Packages = do
              , ghcPkg
              , ghcPrim
              , haskeline
+             , hp2ps
              , hsc2hs
              , intLib
              , pretty
@@ -132,7 +133,7 @@ testsuitePackages = do
              , ghci
              , ghcCompact
              , ghcPkg
-             , hp2ps
+             , hpcBin
              , hsc2hs
              , iserv
              , runGhc