Hadrian: override $(ghc-config-mk), to prevent redundant config generation
[ghc.git] / hadrian / src / Rules / Test.hs
1 module Rules.Test (testRules) where
2
3 import System.Environment
4
5 import Base
6 import CommandLine
7 import Expression
8 import Flavour
9 import Oracles.Setting
10 import Oracles.TestSettings
11 import Packages
12 import Settings
13 import Settings.Default
14 import Settings.Builders.RunTest
15 import Target
16 import Utilities
17
18 ghcConfigHsPath :: FilePath
19 ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
20
21 ghcConfigProgPath :: FilePath
22 ghcConfigProgPath = "test/bin/ghc-config" <.> exe
23
24 checkPprProgPath, checkPprSourcePath :: FilePath
25 checkPprProgPath = "test/bin/check-ppr" <.> exe
26 checkPprSourcePath = "utils/check-ppr/Main.hs"
27
28 checkApiAnnotationsProgPath, checkApiAnnotationsSourcePath :: FilePath
29 checkApiAnnotationsProgPath = "test/bin/check-api-annotations" <.> exe
30 checkApiAnnotationsSourcePath = "utils/check-api-annotations/Main.hs"
31
32 checkPrograms :: [(FilePath, FilePath)]
33 checkPrograms =
34 [ (checkPprProgPath, checkPprSourcePath)
35 , (checkApiAnnotationsProgPath, checkApiAnnotationsSourcePath)
36 ]
37
38 ghcConfigPath :: FilePath
39 ghcConfigPath = "test/ghcconfig"
40
41 -- TODO: clean up after testing
42 testRules :: Rules ()
43 testRules = do
44 root <- buildRootRules
45
46 -- Using program shipped with testsuite to generate ghcconfig file.
47 root -/- ghcConfigProgPath %> \_ -> do
48 ghc0Path <- (<.> exe) <$> getCompilerPath "stage0"
49 cmd [ghc0Path] [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
50
51 -- Rules for building check-ppr and check-ppr-annotations with the compiler
52 -- we are going to test (in-tree or out-of-tree).
53 forM_ checkPrograms $ \(progPath, sourcePath) ->
54 root -/- progPath %> \path -> do
55 testGhc <- testCompiler <$> userSetting defaultTestArgs
56 top <- topDirectory
57 when (testGhc `elem` ["stage1", "stage2", "stage3"]) $ do
58 let stg = stageOf testGhc
59 need . (:[]) =<< programPath (Context stg ghc vanilla)
60 bindir <- getBinaryDirectory testGhc
61 cmd [bindir </> "ghc" <.> exe]
62 ["-package", "ghc", "-o", top -/- path, top -/- sourcePath]
63
64 root -/- ghcConfigPath %> \_ -> do
65 args <- userSetting defaultTestArgs
66 let testGhc = testCompiler args
67 stg = stageOf testGhc
68 ghcPath <- getCompilerPath testGhc
69 when (testGhc `elem` ["stage1", "stage2", "stage3"]) $
70 need . (:[]) =<< programPath (Context stg ghc vanilla)
71 need [root -/- ghcConfigProgPath]
72 cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
73 [ghcPath]
74
75 root -/- timeoutPath %> \_ -> timeoutProgBuilder
76
77 "test" ~> do
78 needTestBuilders
79
80 -- TODO : Should we remove the previosly generated config file?
81 -- Prepare Ghc configuration file for input compiler.
82 need [root -/- ghcConfigPath, root -/- timeoutPath]
83
84 args <- userSetting defaultTestArgs
85 ghcPath <- getCompilerPath (testCompiler args)
86
87 -- TODO This approach doesn't work.
88 -- Set environment variables for test's Makefile.
89 env <- sequence
90 [ builderEnvironment "MAKE" $ Make ""
91 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
92 , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
93
94 makePath <- builderPath $ Make ""
95 top <- topDirectory
96 ghcFlags <- runTestGhcFlags
97 let ghciFlags = ghcFlags ++ unwords
98 [ "--interactive", "-v0", "-ignore-dot-ghci"
99 , "-fno-ghci-history"
100 ]
101
102 pythonPath <- builderPath Python
103 need [ root -/- checkPprProgPath, root -/- checkApiAnnotationsProgPath ]
104
105 -- Set environment variables for test's Makefile.
106 -- TODO: Ideally we would define all those env vars in 'env', so that
107 -- Shake can keep track of them, but it is not as easy as it seems
108 -- to get that to work.
109 liftIO $ do
110 -- Many of those env vars are used by Makefiles in the
111 -- test infrastructure, or from tests or their
112 -- Makefiles.
113 setEnv "MAKE" makePath
114 setEnv "PYTHON" pythonPath
115 setEnv "TEST_HC" ghcPath
116 setEnv "TEST_HC_OPTS" ghcFlags
117 setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags
118 setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
119 setEnv "CHECK_API_ANNOTATIONS"
120 (top -/- root -/- checkApiAnnotationsProgPath)
121
122 -- This lets us bypass the need to generate a config
123 -- through Make, which happens in testsuite/mk/boilerplate.mk
124 -- which is in turn included by all test 'Makefile's.
125 setEnv "ghc-config-mk" (top -/- root -/- ghcConfigPath)
126
127 -- Execute the test target.
128 -- We override the verbosity setting to make sure the user can see
129 -- the test output: https://gitlab.haskell.org/ghc/ghc/issues/15951.
130 withVerbosity Loud $ buildWithCmdOptions env $
131 target (vanillaContext Stage2 compiler) RunTest [] []
132
133 -- | Build the timeout program.
134 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
135 timeoutProgBuilder :: Action ()
136 timeoutProgBuilder = do
137 root <- buildRoot
138 windows <- windowsHost
139 if windows
140 then do
141 prog <- programPath =<< programContext Stage1 timeout
142 copyFile prog (root -/- timeoutPath)
143 else do
144 python <- builderPath Python
145 copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
146 let script = unlines
147 [ "#!/usr/bin/env sh"
148 , "exec " ++ python ++ " $0.py \"$@\"" ]
149 writeFile' (root -/- timeoutPath) script
150 makeExecutable (root -/- timeoutPath)
151
152 needTestBuilders :: Action ()
153 needTestBuilders = do
154 testGhc <- testCompiler <$> userSetting defaultTestArgs
155 when (testGhc `elem` ["stage1", "stage2", "stage3"]) needTestsuitePackages
156
157 -- | Build extra programs and libraries required by testsuite
158 needTestsuitePackages :: Action ()
159 needTestsuitePackages = do
160 testGhc <- testCompiler <$> userSetting defaultTestArgs
161 when (testGhc `elem` ["stage1", "stage2", "stage3"]) $ do
162 let stg = stageOf testGhc
163 allpkgs <- packages <$> flavour
164 stgpkgs <- allpkgs (succ stg)
165 testpkgs <- testsuitePackages
166 targets <- mapM (needFile stg) (stgpkgs ++ testpkgs)
167 needIservBins
168 need targets
169
170 -- stage 1 ghc lives under stage0/bin,
171 -- stage 2 ghc lives under stage1/bin, etc
172 stageOf :: String -> Stage
173 stageOf "stage1" = Stage0
174 stageOf "stage2" = Stage1
175 stageOf "stage3" = Stage2
176 stageOf _ = error "unexpected stage argument"
177
178 needIservBins :: Action ()
179 needIservBins = do
180 -- iserv is not supported under Windows
181 windows <- windowsHost
182 when (not windows) $ do
183 testGhc <- testCompiler <$> userSetting defaultTestArgs
184 let stg = stageOf testGhc
185 rtsways <- interpretInContext (vanillaContext stg ghc) getRtsWays
186 need =<< traverse programPath
187 [ Context stg iserv w
188 | w <- [vanilla, profiling, dynamic]
189 , w `elem` rtsways
190 ]
191
192 needFile :: Stage -> Package -> Action FilePath
193 needFile stage pkg
194 | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
195 | otherwise = programPath =<< programContext stage pkg