Fix timeout building rule for Linux (#638)
[hadrian.git] / src / Rules / Test.hs
1 module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
2
3 import Base
4 import Expression
5 import GHC
6 import GHC.Packages (timeout)
7 import Oracles.Flag
8 import Oracles.Setting
9 import Settings
10 import Target
11 import Utilities
12
13 import System.Environment
14
15 -- TODO: clean up after testing
16 testRules :: Rules ()
17 testRules = do
18 root <- buildRootRules
19
20 -- | Using program shipped with testsuite to generate ghcconfig file.
21 root -/- ghcConfigProgPath ~> do
22 ghc <- builderPath $ Ghc CompileHs Stage0
23 cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
24
25 -- | TODO : Use input test compiler and not just stage2 compiler.
26 root -/- ghcConfigPath ~> do
27 ghcPath <- needfile Stage1 ghc
28 need [ root -/- ghcConfigProgPath]
29 cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
30 [ ghcPath ]
31
32 root -/- timeoutProgPath ~> timeoutProgBuilder
33
34 "validate" ~> do
35 needTestBuilders
36 build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
37
38 "test" ~> do
39 needTestBuilders
40
41 -- TODO : Should we remove the previosly generated config file?
42 -- Prepare Ghc configuration file for input compiler.
43 need [ root -/- ghcConfigPath, root -/- timeoutProgPath ]
44
45 -- TODO This approach doesn't work.
46 -- Set environment variables for test's Makefile.
47 env <- sequence
48 [ builderEnvironment "MAKE" $ Make ""
49 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
50 , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
51
52 makePath <- builderPath $ Make ""
53 top <- topDirectory
54 ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
55 ghcFlags <- runTestGhcFlags
56 checkPprPath <- (top -/-) <$> needfile Stage1 checkPpr
57 annotationsPath <- (top -/-) <$> needfile Stage1 checkApiAnnotations
58
59 -- Set environment variables for test's Makefile.
60 liftIO $ do
61 setEnv "MAKE" makePath
62 setEnv "TEST_HC" ghcPath
63 setEnv "TEST_HC_OPTS" ghcFlags
64 setEnv "CHECK_PPR" checkPprPath
65 setEnv "CHECK_API_ANNOTATIONS" annotationsPath
66
67 -- Execute the test target.
68 buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
69
70 -- | Build extra programs and libraries required by testsuite
71 needTestsuitePackages :: Action ()
72 needTestsuitePackages = do
73 targets <- mapM (needfile Stage1) =<< testsuitePackages
74 binPath <- stageBinPath Stage1
75 libPath <- stageLibPath Stage1
76 iservPath <- needfile Stage1 iserv
77 runhaskellPath <- needfile Stage1 runGhc
78 need targets
79 -- | We need to copy iserv bin to lib/bin as this is where testsuite looks
80 -- | for iserv. Also, using runhaskell gives different stdout due to
81 -- | difference in program name. This causes StdMismatch errors.
82 copyFile iservPath $ libPath -/- "bin/ghc-iserv"
83 copyFile runhaskellPath $ binPath -/- "runghc"
84
85 -- | Build the timeout program.
86 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
87 timeoutProgBuilder :: Action ()
88 timeoutProgBuilder = do
89 root <- buildRoot
90 windows <- windowsHost
91 if windows
92 then do
93 prog <- programPath =<< programContext Stage1 timeout
94 need [ prog ]
95 copyFile prog (root -/- timeoutProgPath)
96 else do
97 python <- builderPath Python
98 copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py")
99 let script = unlines
100 [ "#!/usr/bin/env sh"
101 , "exec " ++ python ++ " $0.py \"$@\""
102 ]
103 writeFile' (root -/- timeoutProgPath) script
104 makeExecutable (root -/- timeoutProgPath)
105
106 needTestBuilders :: Action ()
107 needTestBuilders = do
108 needBuilder $ Ghc CompileHs Stage2
109 needBuilder $ GhcPkg Update Stage1
110 needBuilder Hpc
111 needBuilder (Hsc2Hs Stage1)
112 needTestsuitePackages
113
114 -- | Extra flags to send to the Haskell compiler to run tests.
115 runTestGhcFlags :: Action String
116 runTestGhcFlags = do
117 unregisterised <- flag GhcUnregisterised
118
119 let ifMinGhcVer ver opt = do v <- ghcCanonVersion
120 if ver <= v then pure opt
121 else pure ""
122
123 -- Read extra argument for test from command line, like `-fvectorize`.
124 ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS")
125
126 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28
127 let ghcExtraFlags = if unregisterised
128 then "-optc-fno-builtin"
129 else ""
130
131 -- Take flags to send to the Haskell compiler from test.mk.
132 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
133 unwords <$> sequence
134 [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
135 , pure ghcOpts
136 , pure ghcExtraFlags
137 , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
138 , ifMinGhcVer "711" "-fshow-warning-groups"
139 , ifMinGhcVer "801" "-fdiagnostics-color=never"
140 , ifMinGhcVer "801" "-fno-diagnostics-show-caret"
141 , pure "-dno-debug-output"
142 ]
143
144 timeoutProgPath :: FilePath
145 timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
146
147 ghcConfigHsPath :: FilePath
148 ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
149
150 ghcConfigProgPath :: FilePath
151 ghcConfigProgPath = "test/bin/ghc-config"
152
153 ghcConfigPath :: FilePath
154 ghcConfigPath = "test/ghcconfig"
155
156 needfile :: Stage -> Package -> Action FilePath
157 needfile stage pkg
158 --TODO (Alp): we might sometimes need more than vanilla!
159 -- This should therefore depend on what test ways
160 -- we are going to use, I suppose?
161 | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
162 | otherwise = programPath =<< programContext stage pkg