Add 'hadrian/' from commit '45f3bff7016a2a0cd9a5455a882ced984655e90b'

git-subtree-dir: hadrian
git-subtree-mainline: 575b35f4cdc18045bccd42d341d6f25d95c0696c
git-subtree-split: 45f3bff7016a2a0cd9a5455a882ced984655e90b

1 files changed, 124 insertions, 0 deletions

diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
new file mode 100644
index 0000000000..f5d6990e69
--- /dev/null
+++ b/hadrian/src/Rules/Test.hs
@@ -0,0 +1,124 @@
+module Rules.Test (testRules) where
+
+import System.Environment
+
+import Base
+import Expression
+import Oracles.Setting
+import Packages
+import Settings
+import Settings.Default
+import Settings.Builders.RunTest
+import Target
+import Utilities
+
+ghcConfigHsPath :: FilePath
+ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
+
+ghcConfigProgPath :: FilePath
+ghcConfigProgPath = "test/bin/ghc-config"
+
+ghcConfigPath :: FilePath
+ghcConfigPath = "test/ghcconfig"
+
+-- TODO: clean up after testing
+testRules :: Rules ()
+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
+        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
+
+        -- TODO : Should we remove the previosly generated config file?
+        -- Prepare Ghc configuration file for input compiler.
+        need [root -/- ghcConfigPath, root -/- timeoutPath]
+
+        -- TODO This approach doesn't work.
+        -- Set environment variables for test's Makefile.
+        env <- sequence
+            [ builderEnvironment "MAKE" $ Make ""
+            , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
+            , 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
+
+        -- Set environment variables for test's Makefile.
+        liftIO $ do
+            setEnv "MAKE" makePath
+            setEnv "TEST_HC" ghcPath
+            setEnv "TEST_HC_OPTS" ghcFlags
+            setEnv "CHECK_PPR" checkPprPath
+            setEnv "CHECK_API_ANNOTATIONS" annotationsPath
+
+        -- Execute the test target.
+        buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
+
+-- | Build extra programs and libraries required by testsuite
+needTestsuitePackages :: Action ()
+needTestsuitePackages = do
+    targets   <- mapM (needFile Stage1) =<< testsuitePackages
+    libPath   <- stageLibPath Stage1
+    iservPath <- needFile Stage1 iserv
+    need targets
+    -- | We need to copy iserv bin to lib/bin as this is where testsuite looks
+    -- | for iserv.
+    copyFile iservPath $ libPath -/- "bin/ghc-iserv"
+
+-- | Build the timeout program.
+-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
+timeoutProgBuilder :: Action ()
+timeoutProgBuilder = do
+    root    <- buildRoot
+    windows <- windowsHost
+    if windows
+        then do
+            prog <- programPath =<< programContext Stage1 timeout
+            copyFile prog (root -/- timeoutPath)
+        else do
+            python <- builderPath Python
+            copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
+            let script = unlines
+                    [ "#!/usr/bin/env sh"
+                    , "exec " ++ python ++ " $0.py \"$@\"" ]
+            writeFile' (root -/- timeoutPath) script
+            makeExecutable (root -/- timeoutPath)
+
+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!
+-- 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