hadrian: make it possible to run the testsuite with quickest and quick
[ghc.git] / hadrian / src / Rules / Test.hs
1 module Rules.Test (testRules) where
2
3 import System.Environment
4
5 import Base
6 import Expression
7 import Oracles.Setting
8 import Packages
9 import Settings
10 import Settings.Default
11 import Settings.Builders.RunTest
12 import Target
13 import Utilities
14
15 ghcConfigHsPath :: FilePath
16 ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
17
18 ghcConfigProgPath :: FilePath
19 ghcConfigProgPath = "test/bin/ghc-config"
20
21 ghcConfigPath :: FilePath
22 ghcConfigPath = "test/ghcconfig"
23
24 -- TODO: clean up after testing
25 testRules :: Rules ()
26 testRules = do
27 root <- buildRootRules
28
29 -- | Using program shipped with testsuite to generate ghcconfig file.
30 root -/- ghcConfigProgPath ~> do
31 ghc <- builderPath $ Ghc CompileHs Stage0
32 createDirectory $ takeDirectory (root -/- ghcConfigProgPath)
33 cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
34
35 -- | TODO : Use input test compiler and not just stage2 compiler.
36 root -/- ghcConfigPath ~> do
37 ghcPath <- needFile Stage1 ghc
38 need [root -/- ghcConfigProgPath]
39 cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
40 [ghcPath]
41
42 root -/- timeoutPath ~> timeoutProgBuilder
43
44 "validate" ~> do
45 needTestBuilders
46 build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
47
48 "test" ~> do
49 needTestBuilders
50
51 -- TODO : Should we remove the previosly generated config file?
52 -- Prepare Ghc configuration file for input compiler.
53 need [root -/- ghcConfigPath, root -/- timeoutPath]
54
55 -- TODO This approach doesn't work.
56 -- Set environment variables for test's Makefile.
57 env <- sequence
58 [ builderEnvironment "MAKE" $ Make ""
59 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
60 , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
61
62 makePath <- builderPath $ Make ""
63 top <- topDirectory
64 ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
65 ghcFlags <- runTestGhcFlags
66 checkPprPath <- (top -/-) <$> needFile Stage1 checkPpr
67 annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations
68
69 -- Set environment variables for test's Makefile.
70 liftIO $ do
71 setEnv "MAKE" makePath
72 setEnv "TEST_HC" ghcPath
73 setEnv "TEST_HC_OPTS" ghcFlags
74 setEnv "CHECK_PPR" checkPprPath
75 setEnv "CHECK_API_ANNOTATIONS" annotationsPath
76
77 -- Execute the test target.
78 buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
79
80 -- | Build extra programs and libraries required by testsuite
81 needTestsuitePackages :: Action ()
82 needTestsuitePackages = do
83 targets <- mapM (needFile Stage1) =<< testsuitePackages
84 needIservBins
85 need targets
86
87 -- | Build the timeout program.
88 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
89 timeoutProgBuilder :: Action ()
90 timeoutProgBuilder = do
91 root <- buildRoot
92 windows <- windowsHost
93 if windows
94 then do
95 prog <- programPath =<< programContext Stage1 timeout
96 copyFile prog (root -/- timeoutPath)
97 else do
98 python <- builderPath Python
99 copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
100 let script = unlines
101 [ "#!/usr/bin/env sh"
102 , "exec " ++ python ++ " $0.py \"$@\"" ]
103 writeFile' (root -/- timeoutPath) script
104 makeExecutable (root -/- timeoutPath)
105
106 needIservBins :: Action ()
107 needIservBins = do
108 rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
109 need =<< traverse programPath
110 [ Context Stage1 iserv w
111 | w <- [vanilla, profiling, dynamic]
112 , w `elem` rtsways
113 ]
114
115 needTestBuilders :: Action ()
116 needTestBuilders = do
117 needBuilder $ Ghc CompileHs Stage2
118 needBuilder $ GhcPkg Update Stage1
119 needBuilder Hpc
120 needBuilder $ Hsc2Hs Stage1
121 needTestsuitePackages
122
123 needFile :: Stage -> Package -> Action FilePath
124 needFile stage pkg
125 -- TODO (Alp): we might sometimes need more than vanilla!
126 -- This should therefore depend on what test ways
127 -- we are going to use, I suppose?
128 | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
129 | otherwise = programPath =<< programContext stage pkg