Added support for testsuite (#602)
[hadrian.git] / src / Settings / Builders / RunTest.hs
1 module Settings.Builders.RunTest (runTestBuilderArgs) where
2
3 import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..))
4 import Flavour
5 import GHC.Packages
6 import Hadrian.Builder (getBuilderPath)
7 import Hadrian.Utilities
8 import Oracles.Setting (setting)
9 import Rules.Test
10 import Settings.Builders.Common
11
12 -- Arguments to send to the runtest.py script.
13 runTestBuilderArgs :: Args
14 runTestBuilderArgs = builder RunTest ? do
15 pkgs <- expr $ stagePackages Stage1
16 libTests <- expr $ filterM doesDirectoryExist $ concat
17 [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
18 | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
19
20 debugged <- ghcDebugged <$> expr flavour
21
22 withNativeCodeGen <- expr ghcWithNativeCodeGen
23 withInterpreter <- expr ghcWithInterpreter
24 unregisterised <- expr $ flag GhcUnregisterised
25 withSMP <- expr ghcWithSMP
26
27 windows <- expr windowsHost
28 darwin <- expr osxHost
29
30 threads <- shakeThreads <$> expr getShakeOptions
31 verbose <- shakeVerbosity <$> expr getShakeOptions
32 os <- expr $ setting TargetOs
33 arch <- expr $ setting TargetArch
34 platform <- expr $ setting TargetPlatform
35 top <- expr topDirectory
36 compiler <- getBuilderPath $ Ghc CompileHs Stage2
37 ghcPkg <- getBuilderPath $ GhcPkg Update Stage1
38 haddock <- getBuilderPath $ Haddock BuildPackage
39 hp2ps <- getBuilderPath $ Hp2Ps
40 hpc <- getBuilderPath $ Hpc
41
42 ghcFlags <- expr runTestGhcFlags
43 timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath)
44
45 mconcat [ arg $ "testsuite/driver/runtests.py"
46 , arg $ "--rootdir=" ++ ("testsuite" -/- "tests")
47 , pure ["--rootdir=" ++ test | test <- libTests]
48 , arg "-e", arg $ "windows=" ++ show windows
49 , arg "-e", arg $ "darwin=" ++ show darwin
50 , arg "-e", arg $ "config.speed=2" -- Use default value in GHC's test.mk
51 , arg "-e", arg $ "config.local=True"
52 , arg "-e", arg $ "config.cleanup=False" -- Don't clean up.
53 , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
54 , arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged)
55 , arg "-e", arg $ "ghc_with_native_codegen=" ++ zeroOne withNativeCodeGen
56
57 , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter
58 , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised
59
60 , arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags
61 , arg "-e", arg $ "ghc_with_vanilla=1" -- TODO: do we always build vanilla?
62 , arg "-e", arg $ "ghc_with_dynamic=0" -- TODO: support dynamic
63 , arg "-e", arg $ "ghc_with_profiling=0" -- TODO: support profiling
64
65 , arg "-e", arg $ "config.have_vanilla=1" -- TODO: support other build context
66 , arg "-e", arg $ "config.have_dynamic=0" -- TODO: support dynamic
67 , arg "-e", arg $ "config.have_profiling=0" -- TODO: support profiling
68 , arg "-e", arg $ "ghc_with_smp=" ++ zeroOne withSMP
69 , arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM
70
71 , arg "-e", arg $ "ghc_with_threaded_rts=0" -- TODO: support threaded
72 , arg "-e", arg $ "ghc_with_dynamic_rts=0" -- TODO: support dynamic
73 , arg "-e", arg $ "config.ghc_dynamic_by_default=False" -- TODO: support dynamic
74 , arg "-e", arg $ "config.ghc_dynamic=False" -- TODO: support dynamic
75
76 , arg "-e", arg $ "config.in_tree_compiler=True" -- Use default value, see https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk
77 , arg "-e", arg $ "config.top=" ++ show (top -/- "testsuite")
78 , arg "-e", arg $ "config.wordsize=\"64\""
79 , arg "-e", arg $ "config.os=" ++ show os
80 , arg "-e", arg $ "config.arch=" ++ show arch
81 , arg "-e", arg $ "config.platform=" ++ show platform
82
83 , arg "--config-file=testsuite/config/ghc"
84 , arg "--config", arg $ "compiler=" ++ show (top -/- compiler)
85 , arg "--config", arg $ "ghc_pkg=" ++ show (top -/- ghcPkg)
86 , arg "--config", arg $ "haddock=" ++ show (top -/- haddock)
87 , arg "--config", arg $ "hp2ps=" ++ show (top -/- hp2ps)
88 , arg "--config", arg $ "hpc=" ++ show (top -/- hpc)
89 , arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk
90 , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg)
91 , arg $ "--threads=" ++ show threads
92 , arg $ "--verbose=" ++ show (fromEnum verbose)
93 , getTestArgs -- User-provided arguments from command line.
94 ]
95
96 -- | Prepare the command-line arguments to run GHC's test script.
97 getTestArgs :: Args
98 getTestArgs = do
99 args <- expr $ userSetting defaultTestArgs
100 let testOnlyArg = case testOnly args of
101 Just cases -> map ("--only=" ++) (words cases)
102 Nothing -> []
103 onlyPerfArg = if testOnlyPerf args
104 then Just "--only-perf-tests"
105 else Nothing
106 skipPerfArg = if testSkipPerf args
107 then Just "--skip-perf-tests"
108 else Nothing
109 speedArg = ["-e", "config.speed=" ++ setTestSpeed (testSpeed args)]
110 summaryArg = case testSummary args of
111 Just filepath -> Just $ "--summary-file" ++ quote filepath
112 Nothing -> Just $ "--summary-file=testsuite_summary.txt"
113 junitArg = case testJUnit args of
114 Just filepath -> Just $ "--junit " ++ quote filepath
115 Nothing -> Nothing
116 configArgs = concat [["-e", configArg] | configArg <- testConfigs args]
117 verbosityArg = case testVerbosity args of
118 Nothing -> Nothing
119 Just verbosity -> Just $ "--verbose=" ++ verbosity
120 wayArgs = map ("--way=" ++) (testWays args)
121 pure $ testOnlyArg
122 ++ speedArg
123 ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
124 , junitArg, verbosityArg ]
125 ++ configArgs
126 ++ wayArgs
127
128 -- | Set speed for test
129 setTestSpeed :: TestSpeed -> String
130 setTestSpeed Fast = "2"
131 setTestSpeed Average = "1"
132 setTestSpeed Slow = "0"
133