first attempt at a validate script

9 files changed, 332 insertions, 213 deletions

diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index 1f940f2152..6d606a7914 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -8,11 +8,11 @@ import Data.Either
 import qualified Data.HashMap.Strict as Map
 import Data.List.Extra
 import Development.Shake hiding (Normal)
-import Hadrian.Utilities hiding (buildRoot)
+import qualified Hadrian.Utilities as HU
 import System.Console.GetOpt
 import System.Environment
 
-data TestSpeed = Slow | Average | Fast deriving (Show, Eq)
+data TestSpeed = Slow | Normal | Fast deriving (Show, Eq)
 
 -- | All arguments that can be passed to Hadrian via the command line.
 data CommandLineArgs = CommandLineArgs
@@ -20,10 +20,10 @@ data CommandLineArgs = CommandLineArgs
     , flavour        :: Maybe String
     , freeze1        :: Bool
     , integerSimple  :: Bool
-    , progressColour :: UseColour
-    , progressInfo   :: ProgressInfo
+    , progressColour :: HU.UseColour
+    , progressInfo   :: HU.ProgressInfo
     , splitObjects   :: Bool
-    , buildRoot      :: BuildRoot
+    , buildRoot      :: HU.BuildRoot
     , testArgs       :: TestArgs }
     deriving (Eq, Show)
 
@@ -34,10 +34,10 @@ defaultCommandLineArgs = CommandLineArgs
     , flavour        = Nothing
     , freeze1        = False
     , integerSimple  = False
-    , progressColour = Auto
-    , progressInfo   = Brief
+    , progressColour = HU.Auto
+    , progressInfo   = HU.Brief
     , splitObjects   = False
-    , buildRoot      = BuildRoot "_build"
+    , buildRoot      = HU.BuildRoot "_build"
     , testArgs       = defaultTestArgs }
 
 -- | These arguments are used by the `test` target.
@@ -80,9 +80,9 @@ readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLine
 readBuildRoot ms =
     maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms)
   where
-    go :: String -> Maybe BuildRoot
-    go = Just . BuildRoot
-    set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
+    go :: String -> Maybe HU.BuildRoot
+    go = Just . HU.BuildRoot
+    set :: HU.BuildRoot -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { buildRoot = flag }
 
 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
@@ -95,25 +95,25 @@ readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandL
 readProgressColour ms =
     maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
   where
-    go :: String -> Maybe UseColour
-    go "never"   = Just Never
-    go "auto"    = Just Auto
-    go "always"  = Just Always
+    go :: String -> Maybe HU.UseColour
+    go "never"   = Just HU.Never
+    go "auto"    = Just HU.Auto
+    go "always"  = Just HU.Always
     go _         = Nothing
-    set :: UseColour -> CommandLineArgs -> CommandLineArgs
+    set :: HU.UseColour -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { progressColour = flag }
 
 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readProgressInfo ms =
     maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
   where
-    go :: String -> Maybe ProgressInfo
-    go "none"    = Just None
-    go "brief"   = Just Brief
-    go "normal"  = Just Normal
-    go "unicorn" = Just Unicorn
+    go :: String -> Maybe HU.ProgressInfo
+    go "none"    = Just HU.None
+    go "brief"   = Just HU.Brief
+    go "normal"  = Just HU.Normal
+    go "unicorn" = Just HU.Unicorn
     go _         = Nothing
-    set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
+    set :: HU.ProgressInfo -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { progressInfo = flag }
 
 readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
@@ -160,7 +160,7 @@ readTestSpeed ms =
     go :: String -> Maybe TestSpeed
     go "fast"    = Just Fast
     go "slow"    = Just Slow
-    go "average" = Just Average
+    go "normal"  = Just Normal
     go _         = Nothing
     set :: TestSpeed -> CommandLineArgs -> CommandLineArgs
     set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }
@@ -223,18 +223,18 @@ optDescrs =
 
 -- | A type-indexed map containing Hadrian command line arguments to be passed
 -- to Shake via 'shakeExtra'.
-cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
+cmdLineArgsMap :: IO (Map.HashMap HU.TypeRep HU.Dynamic)
 cmdLineArgsMap = do
     (opts, _, _) <- getOpt Permute optDescrs <$> getArgs
     let args = foldl (flip id) defaultCommandLineArgs (rights opts)
-    return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
-           $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
-           $ insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities
-           $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
-           $ insertExtra args Map.empty
+    return $ HU.insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
+           $ HU.insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
+           $ HU.insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities
+           $ HU.insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
+           $ HU.insertExtra args Map.empty
 
 cmdLineArgs :: Action CommandLineArgs
-cmdLineArgs = userSetting defaultCommandLineArgs
+cmdLineArgs = HU.userSetting defaultCommandLineArgs
 
 cmdConfigure :: Action Bool
 cmdConfigure = configure <$> cmdLineArgs
@@ -242,19 +242,19 @@ cmdConfigure = configure <$> cmdLineArgs
 cmdFlavour :: Action (Maybe String)
 cmdFlavour = flavour <$> cmdLineArgs
 
-lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot
-lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs
+lookupBuildRoot :: Map.HashMap HU.TypeRep HU.Dynamic -> HU.BuildRoot
+lookupBuildRoot = buildRoot . HU.lookupExtra defaultCommandLineArgs
 
-lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
-lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
+lookupFreeze1 :: Map.HashMap HU.TypeRep HU.Dynamic -> Bool
+lookupFreeze1 = freeze1 . HU.lookupExtra defaultCommandLineArgs
 
 cmdIntegerSimple :: Action Bool
 cmdIntegerSimple = integerSimple <$> cmdLineArgs
 
-cmdProgressColour :: Action UseColour
+cmdProgressColour :: Action HU.UseColour
 cmdProgressColour = progressColour <$> cmdLineArgs
 
-cmdProgressInfo :: Action ProgressInfo
+cmdProgressInfo :: Action HU.ProgressInfo
 cmdProgressInfo = progressInfo <$> cmdLineArgs
 
 cmdSplitObjects :: Action Bool
diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs
index 1bf75b527d..827121c13d 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,33 @@ 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.
+-- | 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?
+getBinaryDirectory :: String -> Action FilePath
+getBinaryDirectory "stage0" = takeDirectory <$> setting SystemGhc
+getBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
+getBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
+getBinaryDirectory compiler = pure $ parentPath compiler
+
+-- | Set 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
+
+-- | 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
diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 03740cdad9..f73e8d22a6 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -91,11 +91,16 @@ you can simply do:
 bindistRules :: Rules ()
 bindistRules = do
     root <- buildRootRules
+
     phony "binary-dist" $ do
-        -- We 'need' all binaries and libraries
-        targets <- mapM pkgTarget =<< stagePackages Stage1
-        need targets
+        version        <- setting ProjectVersion
+        targetPlatform <- setting TargetPlatformFull
+        let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform
 
+        need [ root -/- "bindist" -/- ghcVersionPretty <.> "tar.xz" ]
+
+
+    root -/- "bindist" -/- "ghc-*.tar.xz" %> \archivePath -> do
         version        <- setting ProjectVersion
         targetPlatform <- setting TargetPlatformFull
         distDir        <- Context.distDir
@@ -107,6 +112,10 @@ bindistRules = do
             rtsIncludeDir    = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
                                -/- "include"
 
+        -- We 'need' all binaries and libraries built by stage 1
+        targets <- mapM pkgTarget =<< stagePackages Stage1
+        need targets
+
         -- We create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/
         -- and populate it with Stage2 build results
         createDirectory bindistFilesDir
@@ -131,11 +140,10 @@ bindistRules = do
                    , "ghci-script", "ghci", "haddock", "hpc", "hp2ps", "hsc2hs"
                    , "runghc"]
 
-        -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz
         command [Cwd $ root -/- "bindist"] "tar"
-            [ "-c", "--xz", "-f"
-            , ghcVersionPretty <.> "tar.xz"
-            , ghcVersionPretty ]
+                [ "-c", "--xz", "-f"
+                , takeFileName archivePath
+                , ghcVersionPretty ]
 
     -- Prepare binary distribution configure script
     -- (generated under <ghc root>/distrib/configure by 'autoreconf')
@@ -224,19 +232,19 @@ bindistMakefile = unlines
     , "# to it. This implementation is a bit hacky and depends on consistency"
     , "# of program names. For hadrian build this will work as programs have a"
     , "# consistent naming procedure."
-    , "\trm -f $2"
-    , "\t$(CREATE_SCRIPT) $2"
-    , "\t@echo \"#!$(SHELL)\" >>  $2"
-    , "\t@echo \"exedir=\\\"$4\\\"\" >> $2"
-    , "\t@echo \"exeprog=\\\"$1\\\"\" >> $2"
-    , "\t@echo \"executablename=\\\"$5\\\"\" >> $2"
-    , "\t@echo \"bindir=\\\"$3\\\"\" >> $2"
-    , "\t@echo \"libdir=\\\"$6\\\"\" >> $2"
-    , "\t@echo \"docdir=\\\"$7\\\"\" >> $2"
-    , "\t@echo \"includedir=\\\"$8\\\"\" >> $2"
-    , "\t@echo \"\" >> $2 "
-    , "\tcat wrappers/$1 >> $2"
-    , "\t$(EXECUTABLE_FILE) $2 ;"
+    , "\trm -f '$2'"
+    , "\t$(CREATE_SCRIPT) '$2'"
+    , "\t@echo \"#!$(SHELL)\" >>  '$2'"
+    , "\t@echo \"exedir=\\\"$4\\\"\" >> '$2'"
+    , "\t@echo \"exeprog=\\\"$1\\\"\" >> '$2'"
+    , "\t@echo \"executablename=\\\"$5\\\"\" >> '$2'"
+    , "\t@echo \"bindir=\\\"$3\\\"\" >> '$2'"
+    , "\t@echo \"libdir=\\\"$6\\\"\" >> '$2'"
+    , "\t@echo \"docdir=\\\"$7\\\"\" >> '$2'"
+    , "\t@echo \"includedir=\\\"$8\\\"\" >> '$2'"
+    , "\t@echo \"\" >> '$2'"
+    , "\tcat wrappers/$1 >> '$2'"
+    , "\t$(EXECUTABLE_FILE) '$2' ;"
     , "endef"
     , ""
     , "# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'"
@@ -245,10 +253,10 @@ bindistMakefile = unlines
     , "# $1 = package name (ex: 'bytestring')"
     , "# $2 = path to .conf file"
     , "# $3 = Docs Directory"
-    , "\tcat $2 | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\"
-    , "\t       | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\"
-    , "\t       > $2.copy"
-    , "\tmv $2.copy $2"
+    , "\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\"
+    , "\t         | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\"
+    , "\t         > '$2.copy'"
+    , "\tmv '$2.copy' '$2'"
     , "endef"
     , ""
     , "# QUESTION : should we use shell commands?"
@@ -273,10 +281,10 @@ bindistMakefile = unlines
     , ""
     , "install_ghci:"
     , "\t@echo \"Copying and installing ghci\""
-    , "\t$(CREATE_SCRIPT) $(WrapperBinsDir)/ghci"
-    , "\t@echo \"#!$(SHELL)\" >>  $(WrapperBinsDir)/ghci"
-    , "\tcat wrappers/ghci-script >> $(WrapperBinsDir)/ghci"
-    , "\t$(EXECUTABLE_FILE) $(WrapperBinsDir)/ghci"
+    , "\t$(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci'"
+    , "\t@echo \"#!$(SHELL)\" >>  '$(WrapperBinsDir)/ghci'"
+    , "\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'"
+    , "\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'"
     , ""
     , "LIBRARIES = $(wildcard ./lib/*)"
     , "install_lib:"
@@ -302,7 +310,7 @@ bindistMakefile = unlines
     , "\t\tcp -R $$i \"$(docdir)/\"; \\"
     , "\tdone"
     , ""
-    , "BINARY_NAMES=$(shell ls ./bin/)"
+    , "BINARY_NAMES=$(shell ls ./wrappers/)"
     , "install_wrappers:"
     , "\t@echo \"Installing Wrapper scripts\""
     , "\t$(INSTALL_DIR) \"$(WrapperBinsDir)\""
@@ -318,7 +326,7 @@ bindistMakefile = unlines
     , "\t\t$(call patchpackageconf," ++
       "$(shell echo $(notdir $p) | sed 's/-\\([0-9]*[0-9]\\.\\)*conf//g')," ++
       "$p,$(docdir)))"
-    , "\t$(WrapperBinsDir)/ghc-pkg recache"
+    , "\t'$(WrapperBinsDir)/ghc-pkg' recache"
     , ""
     , "# END INSTALL"
     , "# ----------------------------------------------------------------------"
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index d7bcb48712..c7fbf4ed20 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -34,8 +34,7 @@ getProgramContexts stage = do
   sPackages <- filter isProgram <$> stagePackages stage
   tPackages <- testsuitePackages
   -- TODO: Shall we use Stage2 for testsuite packages instead?
-  let allPackages = sPackages
-                ++ if stage == Stage1 then tPackages else []
+  let allPackages = sPackages ++ tPackages
   fmap concat . forM allPackages $ \pkg -> do
     -- the iserv pkg results in three different programs at
     -- the moment, ghc-iserv (built the vanilla way),
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index 461a95f93a..f7d8d5edc9 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -3,8 +3,10 @@ module Rules.Test (testRules) where
 import System.Environment
 
 import Base
+import CommandLine
 import Expression
 import Oracles.Setting
+import Oracles.TestSettings
 import Packages
 import Settings
 import Settings.Default
@@ -28,67 +30,66 @@ testRules = do
 
     -- Using program shipped with testsuite to generate ghcconfig file.
     root -/- ghcConfigProgPath ~> do
-        ghc <- builderPath $ Ghc CompileHs Stage0
+        ghc0Path <- getCompilerPath "stage0"
         createDirectory $ takeDirectory (root -/- ghcConfigProgPath)
-        cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
+        cmd ghc0Path [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
 
     -- TODO : Use input test compiler and not just stage2 compiler.
     root -/- ghcConfigPath ~> do
-        ghcPath <- needFile Stage1 ghc
+        args <- userSetting defaultTestArgs
+        let testGhc = testCompiler args
+        ghcPath <- getCompilerPath testGhc
+        when (testGhc `elem` ["stage1", "stage2"]) $ need [ ghcPath ]
         need [root -/- ghcConfigProgPath]
         cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
             [ghcPath]
 
     root -/- timeoutPath ~> timeoutProgBuilder
 
-    "validate" ~> do
-        needTestBuilders
-        build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
-
     "test" ~> do
-        needTestBuilders
+        -- needTestBuilders
 
         -- TODO : Should we remove the previosly generated config file?
         -- 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
             [ builderEnvironment "MAKE" $ Make ""
-            , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
+            , pure (AddEnv "TEST_HC" ghcPath)
             , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
 
         makePath        <- builderPath $ Make ""
         top             <- topDirectory
-        ghcPath         <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
         ghcFlags        <- runTestGhcFlags
-        checkPprPath    <- (top -/-) <$> needFile Stage1 checkPpr
-        annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations
+
+        -- where to get those from?
+        checkPprPath    <- needFile Stage0 checkPpr
+        annotationsPath <- needFile Stage0 checkApiAnnotations
+        pythonPath      <- builderPath Python
+        need [ checkPprPath, annotationsPath ]
 
         -- Set environment variables for test's Makefile.
         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 "CHECK_PPR" (top </> checkPprPath)
+            setEnv "CHECK_API_ANNOTATIONS" (top </> annotationsPath)
 
         -- Execute the test target.
         -- We override the verbosity setting to make sure the user can see
         -- the test output: https://ghc.haskell.org/trac/ghc/ticket/15951.
         withVerbosity Loud $ buildWithCmdOptions env $
+            -- is it really the right target, especially with an
+            -- external ghc?
             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,11 +109,36 @@ timeoutProgBuilder = do
             writeFile' (root -/- timeoutPath) script
             makeExecutable (root -/- timeoutPath)
 
+needTestBuilders :: Action ()
+needTestBuilders = do
+    testGhc <- testCompiler <$> userSetting defaultTestArgs
+    ghcPath <- getCompilerPath testGhc
+    bindir <- getBinaryDirectory testGhc
+    when (testGhc `elem` ["stage1", "stage2"]) needTestsuitePackages
+
+-- | Build extra programs and libraries required by testsuite
+needTestsuitePackages :: Action ()
+needTestsuitePackages = do
+    testGhc <- testCompiler <$> userSetting defaultTestArgs
+    when (testGhc `elem` ["stage1", "stage2"]) $ do
+        let stg = stageOf testGhc
+        targets   <- mapM (needFile stg) =<< testsuitePackages
+        -- iserv is not supported under Windows
+        windows <- windowsHost
+        when (not windows) needIservBins
+        need targets
+
+    where stageOf "stage1" = Stage1
+          stageOf "stage2" = Stage2
+          stageOf _ = error "unexpected argument"
+
 needIservBins :: Action ()
 needIservBins = do
-    rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
+    testGhc <- testCompiler <$> userSetting defaultTestArgs
+    let stg = if testGhc == "stage1" then Stage0 else Stage1
+    rtsways <- interpretInContext (vanillaContext stg ghc) getRtsWays
     need =<< traverse programPath
-               [ Context Stage1 iserv w
+               [ Context stg iserv w
                | w <- [vanilla, profiling
                     -- TODO dynamic way has been reverted as the dynamic build
                     --      is broken. See #15837.
@@ -121,14 +147,6 @@ needIservBins = do
                , w `elem` rtsways
                ]
 
-needTestBuilders :: Action ()
-needTestBuilders = do
-    needBuilder $ Ghc CompileHs Stage2
-    needBuilder $ GhcPkg Update Stage1
-    needBuilder Hpc
-    needBuilder $ Hsc2Hs Stage1
-    needTestsuitePackages
-
 needFile :: Stage -> Package -> Action FilePath
 needFile stage pkg
 -- TODO (Alp): we might sometimes need more than vanilla!
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 0433888279..dda42f10c0 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -3,7 +3,7 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where
 import Oracles.Setting
 import Packages
 import Rules.Gmp
-import Settings.Builders.Common
+import Settings.Builders.Common hiding (Normal)
 import CommandLine
 
 makeBuilderArgs :: Args
@@ -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 Fast   = "fasttest"
+setTestSpeed Normal = "test"
+setTestSpeed Slow   = "slowtest"
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 55a5e5871a..05b6555170 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -1,14 +1,13 @@
 module Settings.Builders.RunTest (runTestBuilderArgs, runTestGhcFlags) where
 
-import Hadrian.Utilities
+import Hadrian.Utilities hiding (Normal)
 import System.Environment
 
 import CommandLine
 import Flavour
-import Oracles.Setting (setting)
 import Oracles.TestSettings
 import Packages
-import Settings.Builders.Common
+import Settings.Builders.Common hiding (Normal)
 
 getTestSetting :: TestSetting -> Expr String
 getTestSetting key = expr $ testSetting key
@@ -58,18 +57,19 @@ runTestBuilderArgs = builder RunTest ? do
             [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
             | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
 
+    testGhc <- expr (testCompiler <$> userSetting defaultTestArgs)
     flav    <- expr flavour
     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
 
     windows     <- expr windowsHost
     darwin      <- expr osxHost
@@ -93,8 +93,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=" ++
+                show (elem testGhc ["stage1", "stage2"])
+            , arg "-e", arg $ "config.cleanup=False" -- Don't clean up for now.
             , 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
@@ -115,9 +116,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
@@ -136,8 +134,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)
@@ -149,10 +147,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 \"" ++ 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
@@ -164,46 +162,35 @@ 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"]) ]
+
     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 Slow   = "0"
+setTestSpeed Normal = "1"
+setTestSpeed Fast   = "2"
+
+inferLibraryWays :: String -> Action [Way]
+inferLibraryWays compiler = do
+  bindir <- getBinaryDirectory compiler
+  Stdout ghcPrimLibdir <- cmd [Cwd bindir]
+    ("ghc-pkg")
+    ["field", "ghc-prim", "library-dirs", "--simple-output"]
+  catMaybes <$> traverse (lookForWay ghcPrimLibdir) candidateWays
+
+  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)
+          ]
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index e2d7644beb..ca4b0d16e1 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -58,6 +58,8 @@ stage0Packages = do
     cross <- flag CrossCompiling
     return $ [ binary
              , cabal
+             , checkApiAnnotations
+             , checkPpr
              , compareSizes
              , compiler
              , deriveConstants
@@ -100,6 +102,7 @@ stage1Packages = do
              , ghcPkg
              , ghcPrim
              , haskeline
+             , hp2ps
              , hsc2hs
              , intLib
              , pretty
diff --git a/validate b/validate
index 8ceaa6105d..dc2dbc34f7 100755
--- a/validate
+++ b/validate
@@ -25,6 +25,7 @@ Flags:
                     2008-07-01: 14% slower than the default.
   --quiet           More pretty build log.
                     See Note [Default build system verbosity].
+  --hadrian         Build the compiler and run the tests through hadrian.
   --help            shows this usage help.
 
   validate runs 'make -j\$THREADS', where by default THREADS is the number of
@@ -54,6 +55,7 @@ be_quiet=0
 # heavy cost of xz, which is the typical default. The options are defined in
 # mk/config.mk.in
 tar_comp=gzip
+use_hadrian=NO
 
 while [ $# -gt 0 ]
 do
@@ -82,6 +84,10 @@ do
     --quiet)
         be_quiet=1
         ;;
+    --hadrian)
+	use_hadrian=YES
+	hadrian_build_root=_validatebuild
+	;;
     --help)
         show_help
         exit 0;;
@@ -96,7 +102,12 @@ done
 check_packages () {
     if [ "$bindistdir" = "" ]
     then
-        ghc_pkg=inplace/bin/ghc-pkg
+	if [ "$use_hadrian" = "YES" ]
+	then
+	    ghc_pkg=$hadrian_build_root/stage1/bin/ghc-pkg
+	else
+            ghc_pkg=inplace/bin/ghc-pkg
+	fi
     else
         ghc_pkg="$bindistdir"/bin/ghc-pkg
     fi
@@ -127,26 +138,37 @@ fi
 
 echo "using THREADS=${threads}" >&2
 
-if type gmake > /dev/null 2> /dev/null
+if [ "$use_hadrian" = "NO" ]
 then
-    make="gmake"
+   if type gmake > /dev/null 2> /dev/null
+   then
+       make="gmake"
+   else
+       make="make"
+   fi
+   if [ $be_quiet -eq 1 ]; then
+       # See Note [Default build system verbosity].
+       make="$make -s"
+   fi
+   $make -C utils/checkUniques
 else
-    make="make"
-fi
-
-if [ $be_quiet -eq 1 ]; then
-    # See Note [Default build system verbosity].
-    make="$make -s"
+    hadrian="hadrian/build.sh -j$threads --build-root=$hadrian_build_root"
+    if [ $be_quiet -eq 0 ]; then
+	hadrian="$hadrian -V"
+    fi
 fi
 
-$make -C utils/checkUniques
-
 if [ $testsuite_only -eq 0 ]; then
 
 thisdir=`pwd`
 
 if [ $no_clean -eq 0 ]; then
-    $make maintainer-clean
+    if [ "$use_hadrian" = "NO" ]
+    then
+	$make maintainer-clean
+    else
+	$hadrian clean && rm -rf $hadrian_build_root
+    fi
 
     INSTDIR="$thisdir/inst"
 
@@ -154,27 +176,32 @@ if [ $no_clean -eq 0 ]; then
     ./configure --prefix="$INSTDIR" $config_args
 fi
 
-echo "Validating=YES"       >  mk/are-validating.mk
-echo "ValidateSpeed=$speed" >> mk/are-validating.mk
-echo "ValidateHpc=$hpc"     >> mk/are-validating.mk
-
-# Note [Default build system verbosity].
-#
-# From https://ghc.haskell.org/trac/ghc/wiki/Design/BuildSystem:
-#
-#   "The build system should clearly report what it's doing (and sometimes
-#   why), without being too verbose. It should emit actual command lines as
-#   much as possible, so that they can be inspected and cut & pasted."
-#
-# That should be the default. Only suppress commands, by setting V=0 and using
-# `make -s`, when user explicitly asks for it with `./validate --quiet`.
-if [ $be_quiet -eq 1 ]; then
-    # See Note [Default build system verbosity].
-    echo "V=0"                  >> mk/are-validating.mk # Less gunk
-fi
+if [ "$use_hadrian" = "NO" ]
+then
+    echo "Validating=YES"       >  mk/are-validating.mk
+    echo "ValidateSpeed=$speed" >> mk/are-validating.mk
+    echo "ValidateHpc=$hpc"     >> mk/are-validating.mk
 
-$make -j$threads
-# For a "debug make", add "--debug=b --debug=m"
+    # Note [Default build system verbosity].
+    #
+    # From https://ghc.haskell.org/trac/ghc/wiki/Design/BuildSystem:
+    #
+    #   "The build system should clearly report what it's doing (and sometimes
+    #   why), without being too verbose. It should emit actual command lines as
+    #   much as possible, so that they can be inspected and cut & pasted."
+    #
+    # That should be the default. Only suppress commands, by setting V=0 and using
+    # `make -s`, when user explicitly asks for it with `./validate --quiet`.
+    if [ $be_quiet -eq 1 ]; then
+	# See Note [Default build system verbosity].
+	echo "V=0"                  >> mk/are-validating.mk # Less gunk
+    fi
+
+    $make -j$threads
+    # For a "debug make", add "--debug=b --debug=m"
+else
+    $hadrian
+fi
 
 check_packages post-build
 
@@ -183,19 +210,47 @@ check_packages post-build
 
 if [ $speed != "FAST" ]; then
 
-    $make binary-dist-prep TAR_COMP=$tar_comp
-    $make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp
+    bindistdir="bindisttest/install   dir"
+
+    if [ "$use_hadrian" = "NO" ]
+    then
+	$make binary-dist-prep TAR_COMP=$tar_comp
+	$make test_bindist TEST_PREP=YES TAR_COMP=$tar_comp
+    else
+	# $hadrian binary-dist
+	# cd $hadrian_build_root/bindist/
+	# dir=$(ls | grep -v tar)
+	# cd $dir
+	# ./configure --prefix="$thisdir/$bindistdir" && make install
+	# cd $thisdir
+	ghc="$bindistdir/bin/ghc"
+	"$ghc" -e '1+1'
+    fi
+
+    check_packages post-install
 
     #
     # Install the xhtml package into the bindist.
     # This verifies that we can install a package into the
     # bindist with Cabal.
     #
-    bindistdir="bindisttest/install   dir"
-
-    check_packages post-install
-
-    $make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir"
+    if [ "$use_hadrian" = "NO" ]
+    then
+	$make validate_build_xhtml BINDIST_PREFIX="$thisdir/$bindistdir"
+    else
+	cd libraries/xhtml
+	"$thisdir/$bindistdir/bin/ghc" --make Setup
+	# TODO: Add --with-haddock=...
+	./Setup configure --with-ghc="$thisdir/$bindistdir/bin/ghc" \
+		--global --builddir=dist-bindist \
+		--prefix="$thisdir/$bindistdir"
+	./Setup build --builddir=dist-bindist
+	# TODO: ./Setup haddock
+	./Setup install --builddir=dist-bindist
+	./Setup clean --builddir=dist-bindist
+	rm -f Setup Setup.exe Setup.hi Setup.o
+	cd ../../
+    fi
 
     check_packages post-xhtml
 fi
@@ -226,15 +281,18 @@ then
 fi
 
 case "$speed" in
-SLOW)
+    SLOW)
+	HADRIAN_TEST_SPEED=slow
         MAKE_TEST_TARGET=slowtest
         BINDIST="BINDIST=YES"
         ;;
-NORMAL)
+    NORMAL)
+	HADRIAN_TEST_SPEED=normal
         MAKE_TEST_TARGET=test
         BINDIST="BINDIST=YES"
         ;;
-FAST)
+    FAST)
+	HADRIAN_TEST_SPEED=fast
         MAKE_TEST_TARGET=fasttest
         BINDIST="BINDIST=NO"
         ;;
@@ -252,21 +310,31 @@ fi
 
 rm -f testsuite_summary.txt testsuite_summary_stage1.txt
 
-# Use LOCAL=0, see Note [Running tests in /tmp].
-$make -C testsuite/tests $BINDIST $PYTHON_ARG \
-      $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
-      NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \
-      JUNIT_FILE=../../testsuite.xml \
-      2>&1 | tee testlog
-
-# Run a few tests using the stage1 compiler.
-# See Note [Why is there no stage1 setup function?].
-# Don't use BINDIST=YES, as stage1 is not available in a bindist.
-$make -C testsuite/tests/stage1 $PYTHON_ARG \
-      $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
-      NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \
-      JUNIT_FILE=../../../testsuite_stage1.xml \
-      2>&1 | tee testlog-stage1
+if [ "$use_hadrian" = "NO" ]
+then
+    # Use LOCAL=0, see Note [Running tests in /tmp].
+    $make -C testsuite/tests $BINDIST $PYTHON_ARG \
+	  $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
+	  NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \
+	  JUNIT_FILE=../../testsuite.xml \
+	  2>&1 | tee testlog
+
+    # Run a few tests using the stage1 compiler.
+    # See Note [Why is there no stage1 setup function?].
+    # Don't use BINDIST=YES, as stage1 is not available in a bindist.
+    $make -C testsuite/tests/stage1 $PYTHON_ARG \
+	  $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
+	  NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \
+	  JUNIT_FILE=../../../testsuite_stage1.xml \
+	  2>&1 | tee testlog-stage1
+else
+    # TODO: run stage 1 tests too
+    echo "Stage 1 tests not supported by hadrian" > testsuite_summary_stage1.txt
+    $hadrian test --test-speed=$HADRIAN_TEST_SPEED \
+                  --test-compiler="$thisdir/$bindistdir/bin/ghc" \
+                  --summary=$thisdir/testsuite_summary.txt \
+                  --summary-junit=$thisdir/testsuite.xml
+fi
 
 echo
 echo '==== STAGE 1 TESTS ==== '