Hadrian: include 'findPtr' via find-ptr cabal flag
[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 -- We override the verbosity setting to make sure the user can see
79 -- the test output: https://ghc.haskell.org/trac/ghc/ticket/15951.
80 withVerbosity Loud $ buildWithCmdOptions env $
81 target (vanillaContext Stage2 compiler) RunTest [] []
82
83 -- | Build extra programs and libraries required by testsuite
84 needTestsuitePackages :: Action ()
85 needTestsuitePackages = do
86 targets <- mapM (needFile Stage1) =<< testsuitePackages
87 -- iserv is not supported under Windows
88 windows <- windowsHost
89 when (not windows) needIservBins
90 need targets
91
92 -- | Build the timeout program.
93 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
94 timeoutProgBuilder :: Action ()
95 timeoutProgBuilder = do
96 root <- buildRoot
97 windows <- windowsHost
98 if windows
99 then do
100 prog <- programPath =<< programContext Stage1 timeout
101 copyFile prog (root -/- timeoutPath)
102 else do
103 python <- builderPath Python
104 copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
105 let script = unlines
106 [ "#!/usr/bin/env sh"
107 , "exec " ++ python ++ " $0.py \"$@\"" ]
108 writeFile' (root -/- timeoutPath) script
109 makeExecutable (root -/- timeoutPath)
110
111 needIservBins :: Action ()
112 needIservBins = do
113 rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
114 need =<< traverse programPath
115 [ Context Stage1 iserv w
116 | w <- [vanilla, profiling, dynamic]
117 , w `elem` rtsways
118 ]
119
120 needTestBuilders :: Action ()
121 needTestBuilders = do
122 needBuilder $ Ghc CompileHs Stage2
123 needBuilder $ GhcPkg Update Stage1
124 needBuilder Hpc
125 needBuilder $ Hsc2Hs Stage1
126 needTestsuitePackages
127
128 needFile :: Stage -> Package -> Action FilePath
129 needFile stage pkg
130 -- TODO (Alp): we might sometimes need more than vanilla!
131 -- This should therefore depend on what test ways
132 -- we are going to use, I suppose?
133 | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
134 | otherwise = programPath =<< programContext stage pkg