b7b234dd0ff669a86ab2efb7547355fce3167656
[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 Oracles.Flag
7 import Oracles.Setting
8 import Target
9 import Utilities
10
11 import System.Environment
12
13 -- TODO: clean up after testing
14 testRules :: Rules ()
15 testRules = do
16 root <- buildRootRules
17
18 root -/- timeoutPyPath ~> do
19 copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPyPath)
20
21 -- TODO windows is still not supported.
22 --
23 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
24 root -/- timeoutProgPath ~> do
25 python <- builderPath Python
26 need [root -/- timeoutPyPath]
27 let script = unlines
28 [ "#!/usr/bin/env sh"
29 , "exec " ++ python ++ " $0.py \"$@\""
30 ]
31 liftIO $ do
32 writeFile (root -/- timeoutProgPath) script
33 makeExecutable (root -/- timeoutProgPath)
34
35 "validate" ~> do
36 needTestBuilders
37 build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
38
39 "test" ~> do
40 needTestBuilders
41
42 -- Prepare the timeout program.
43 need [ 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
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
63 -- Execute the test target.
64 buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
65
66 needTestBuilders :: Action ()
67 needTestBuilders = do
68 needBuilder $ Ghc CompileHs Stage2
69 needBuilder $ GhcPkg Update Stage1
70 needBuilder Hp2Ps
71 needBuilder Hpc
72 needBuilder (Hsc2Hs Stage1)
73
74 -- | Extra flags to send to the Haskell compiler to run tests.
75 runTestGhcFlags :: Action String
76 runTestGhcFlags = do
77 unregisterised <- flag GhcUnregisterised
78
79 let ifMinGhcVer ver opt = do v <- ghcCanonVersion
80 if ver <= v then pure opt
81 else pure ""
82
83 -- Read extra argument for test from command line, like `-fvectorize`.
84 ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS")
85
86 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28
87 let ghcExtraFlags = if unregisterised
88 then "-optc-fno-builtin"
89 else ""
90
91 -- Take flags to send to the Haskell compiler from test.mk.
92 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
93 unwords <$> sequence
94 [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
95 , pure ghcOpts
96 , pure ghcExtraFlags
97 , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
98 , ifMinGhcVer "711" "-fshow-warning-groups"
99 , ifMinGhcVer "801" "-fdiagnostics-color=never"
100 , ifMinGhcVer "801" "-fno-diagnostics-show-caret"
101 , pure "-dno-debug-output"
102 ]
103
104 timeoutPyPath :: FilePath
105 timeoutPyPath = "test/bin/timeout.py"
106
107 timeoutProgPath :: FilePath
108 timeoutProgPath = "test/bin/timeout" <.> exe