d8d644e7f805e46bee65c11f73dff6aa2e86061a
[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 "validate" ~> do
33 needTestBuilders
34 build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
35
36 "test" ~> do
37 needTestBuilders
38
39 -- TODO : Should we remove the previosly generated config file?
40 -- Prepare Ghc configuration file for input compiler.
41 need [ root -/- ghcConfigPath ]
42
43 -- TODO This approach doesn't work.
44 -- Set environment variables for test's Makefile.
45 env <- sequence
46 [ builderEnvironment "MAKE" $ Make ""
47 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
48 , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
49
50 makePath <- builderPath $ Make ""
51 top <- topDirectory
52 ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
53 ghcFlags <- runTestGhcFlags
54 checkPprPath <- (top -/-) <$> needfile Stage1 checkPpr
55 annotationsPath <- (top -/-) <$> needfile Stage1 checkApiAnnotations
56
57 -- Set environment variables for test's Makefile.
58 liftIO $ do
59 setEnv "MAKE" makePath
60 setEnv "TEST_HC" ghcPath
61 setEnv "TEST_HC_OPTS" ghcFlags
62 setEnv "CHECK_PPR" checkPprPath
63 setEnv "CHECK_API_ANNOTATIONS" annotationsPath
64
65 -- Execute the test target.
66 buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
67
68 -- | Build extra programs and libraries required by testsuite
69 needTestsuitePackages :: Action ()
70 needTestsuitePackages = do
71 targets <- mapM (needfile Stage1) =<< testsuitePackages
72 binPath <- stageBinPath Stage1
73 libPath <- stageLibPath Stage1
74 iservPath <- needfile Stage1 iserv
75 runhaskellPath <- needfile Stage1 runGhc
76 need targets
77 -- | We need to copy iserv bin to lib/bin as this is where testsuite looks
78 -- | for iserv. Also, using runhaskell gives different stdout due to
79 -- | difference in program name. This causes StdMismatch errors.
80 copyFile iservPath $ libPath -/- "bin/ghc-iserv"
81 copyFile runhaskellPath $ binPath -/- "runghc"
82
83 -- | Build the timeout program.
84 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
85 timeoutProgBuilder :: Action ()
86 timeoutProgBuilder = do
87 root <- buildRoot
88 windows <- windowsHost
89 if windows
90 then do
91 prog <- programPath =<< programContext Stage1 timeout
92 need [ prog ]
93 copyFile prog (root -/- timeoutProgPath)
94 else do
95 python <- builderPath Python
96 copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py")
97 let script = unlines
98 [ "#!/usr/bin/env sh"
99 , "exec " ++ python ++ " $0.py \"$@\""
100 ]
101 liftIO $ do
102 writeFile (root -/- timeoutProgPath) script
103 makeExecutable (root -/- timeoutProgPath)
104
105 needTestBuilders :: Action ()
106 needTestBuilders = do
107 needBuilder $ Ghc CompileHs Stage2
108 needBuilder $ GhcPkg Update Stage1
109 needBuilder Hpc
110 needBuilder (Hsc2Hs Stage1)
111 timeoutProgBuilder
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
163