[WIP] Support run GHC's test from hadrian. (#495)
[hadrian.git] / src / Rules / Test.hs
1 module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
2
3 import Base
4 import Expression
5 import Oracles.Flag
6 import Oracles.Setting
7 import Target
8 import Utilities
9
10 import System.Environment
11
12 -- TODO: clean up after testing
13 testRules :: Rules ()
14 testRules = do
15
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 need inplaceLibCopyTargets
37 needBuilder $ Ghc CompileHs Stage2
38 needBuilder $ GhcPkg Update Stage1
39 needBuilder Hpc
40 -- TODO: Figure out why @needBuilder Hsc2Hs@ doesn't work.
41 -- TODO: Eliminate explicit filepaths.
42 -- See https://github.com/snowleopard/hadrian/issues/376.
43 need ["inplace/bin/hp2ps", "inplace/bin/hsc2hs"]
44 build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
45
46 "test" ~> do
47 -- Prepare the timeout program.
48 need [ root -/- timeoutProgPath ]
49
50 -- TODO This approach doesn't work.
51 -- Set environment variables for test's Makefile.
52 env <- sequence
53 [ builderEnvironment "MAKE" $ Make ""
54 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
55 , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
56
57 makePath <- builderPath $ Make ""
58 top <- topDirectory
59 ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
60 ghcFlags <- runTestGhcFlags
61
62 -- Set environment variables for test's Makefile.
63 liftIO $ do
64 setEnv "MAKE" makePath
65 setEnv "TEST_HC" ghcPath
66 setEnv "TEST_HC_OPTS" ghcFlags
67
68 -- Execute the test target.
69 buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
70
71 -- | Extra flags to send to the Haskell compiler to run tests.
72 runTestGhcFlags :: Action String
73 runTestGhcFlags = do
74 unregisterised <- flag GhcUnregisterised
75
76 let ifMinGhcVer ver opt = do v <- ghcCanonVersion
77 if ver <= v then pure opt
78 else pure ""
79
80 -- Read extra argument for test from command line, like `-fvectorize`.
81 ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS")
82
83 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28
84 let ghcExtraFlags = if unregisterised
85 then "-optc-fno-builtin"
86 else ""
87
88 -- Take flags to send to the Haskell compiler from test.mk.
89 -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
90 unwords <$> sequence
91 [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts"
92 , pure ghcOpts
93 , pure ghcExtraFlags
94 , ifMinGhcVer "711" "-fno-warn-missed-specialisations"
95 , ifMinGhcVer "711" "-fshow-warning-groups"
96 , ifMinGhcVer "801" "-fdiagnostics-color=never"
97 , ifMinGhcVer "801" "-fno-diagnostics-show-caret"
98 , pure "-dno-debug-output"
99 ]
100
101 timeoutPyPath :: FilePath
102 timeoutPyPath = "test/bin/timeout.py"
103
104 timeoutProgPath :: FilePath
105 timeoutProgPath = "test/bin/timeout" <.> exe