Add test compiler option to test (#621)
[hadrian.git] / src / CommandLine.hs
1 module CommandLine (
2 optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
3 cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
4 cmdInstallDestDir, lookupBuildRoot, TestArgs(..), TestSpeed(..),
5 defaultTestArgs
6 ) where
7
8 import Data.Either
9 import qualified Data.HashMap.Strict as Map
10 import Data.List.Extra
11 import Development.Shake hiding (Normal)
12 import Hadrian.Utilities hiding (buildRoot)
13 import System.Console.GetOpt
14 import System.Environment
15
16 data TestSpeed = Slow | Average | Fast deriving (Show, Eq)
17
18 -- | All arguments that can be passed to Hadrian via the command line.
19 data CommandLineArgs = CommandLineArgs
20 { configure :: Bool
21 , flavour :: Maybe String
22 , freeze1 :: Bool
23 , installDestDir :: Maybe String
24 , integerSimple :: Bool
25 , progressColour :: UseColour
26 , progressInfo :: ProgressInfo
27 , splitObjects :: Bool
28 , buildRoot :: BuildRoot
29 , testArgs :: TestArgs }
30 deriving (Eq, Show)
31
32 -- | Default values for 'CommandLineArgs'.
33 defaultCommandLineArgs :: CommandLineArgs
34 defaultCommandLineArgs = CommandLineArgs
35 { configure = False
36 , flavour = Nothing
37 , freeze1 = False
38 , installDestDir = Nothing
39 , integerSimple = False
40 , progressColour = Auto
41 , progressInfo = Brief
42 , splitObjects = False
43 , buildRoot = BuildRoot "_build"
44 , testArgs = defaultTestArgs }
45
46 -- | These arguments are used by the `test` target.
47 data TestArgs = TestArgs
48 { testCompiler :: String
49 , testConfigs :: [String]
50 , testJUnit :: Maybe FilePath
51 , testOnly :: Maybe String
52 , testOnlyPerf :: Bool
53 , testSkipPerf :: Bool
54 , testSpeed :: TestSpeed
55 , testSummary :: Maybe FilePath
56 , testVerbosity:: Maybe String
57 , testWays :: [String] }
58 deriving (Eq, Show)
59
60 -- | Default value for `TestArgs`.
61 defaultTestArgs :: TestArgs
62 defaultTestArgs = TestArgs
63 { testCompiler = "stage2"
64 , testConfigs = []
65 , testJUnit = Nothing
66 , testOnly = Nothing
67 , testOnlyPerf = False
68 , testSkipPerf = False
69 , testSpeed = Average
70 , testSummary = Nothing
71 , testVerbosity= Nothing
72 , testWays = [] }
73
74 readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
75 readConfigure = Right $ \flags -> flags { configure = True }
76
77 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
78 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
79
80 readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs)
81 readBuildRoot ms =
82 maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms)
83 where
84 go :: String -> Maybe BuildRoot
85 go = Just . BuildRoot
86 set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
87 set flag flags = flags { buildRoot = flag }
88
89 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
90 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
91
92 readInstallDestDir :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
93 readInstallDestDir ms = Right $ \flags -> flags { installDestDir = ms }
94
95 readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
96 readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
97
98 readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
99 readProgressColour ms =
100 maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
101 where
102 go :: String -> Maybe UseColour
103 go "never" = Just Never
104 go "auto" = Just Auto
105 go "always" = Just Always
106 go _ = Nothing
107 set :: UseColour -> CommandLineArgs -> CommandLineArgs
108 set flag flags = flags { progressColour = flag }
109
110 readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
111 readProgressInfo ms =
112 maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
113 where
114 go :: String -> Maybe ProgressInfo
115 go "none" = Just None
116 go "brief" = Just Brief
117 go "normal" = Just Normal
118 go "unicorn" = Just Unicorn
119 go _ = Nothing
120 set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
121 set flag flags = flags { progressInfo = flag }
122
123 readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
124 readSplitObjects = Right $ \flags -> flags { splitObjects = True }
125
126 readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
127 readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler
128 where
129 set compiler = \flags -> flags { testArgs = (testArgs flags) { testCompiler = compiler } }
130
131 readTestConfig :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
132 readTestConfig config =
133 case config of
134 Nothing -> Right id
135 Just conf -> Right $ \flags ->
136 let configs = conf : testConfigs (testArgs flags)
137 in flags { testArgs = (testArgs flags) { testConfigs = configs } }
138
139 readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
140 readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
141
142 readTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
143 readTestOnly tests = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnly = tests } }
144
145 readTestOnlyPerf :: Either String (CommandLineArgs -> CommandLineArgs)
146 readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testOnlyPerf = True } }
147
148 readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
149 readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
150
151 readTestSpeed :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
152 readTestSpeed ms =
153 maybe (Left "Cannot parse test-speed") (Right . set) (go =<< lower <$> ms)
154 where
155 go :: String -> Maybe TestSpeed
156 go "fast" = Just Fast
157 go "slow" = Just Slow
158 go "average" = Just Average
159 go _ = Nothing
160 set :: TestSpeed -> CommandLineArgs -> CommandLineArgs
161 set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }
162
163 readTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
164 readTestSummary filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
165
166 readTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
167 readTestVerbose verbose = Right $ \flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } }
168
169 readTestWay :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
170 readTestWay way =
171 case way of
172 Nothing -> Right id
173 Just way -> Right $ \flags ->
174 let newWays = way : testWays (testArgs flags)
175 in flags { testArgs = (testArgs flags) {testWays = newWays} }
176
177 -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
178 optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
179 optDescrs =
180 [ Option ['c'] ["configure"] (NoArg readConfigure)
181 "Run the boot and configure scripts (if you do not want to run them manually)."
182 , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT")
183 "Where to store build artifacts. (Default _build)."
184 , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
185 "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
186 , Option [] ["freeze1"] (NoArg readFreeze1)
187 "Freeze Stage1 GHC."
188 , Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
189 "Installation destination directory."
190 , Option [] ["integer-simple"] (NoArg readIntegerSimple)
191 "Build GHC with integer-simple library."
192 , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
193 "Use colours in progress info (Never, Auto or Always)."
194 , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
195 "Progress info style (None, Brief, Normal or Unicorn)."
196 , Option [] ["split-objects"] (NoArg readSplitObjects)
197 "Generate split objects (requires a full clean rebuild)."
198 , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER")
199 "Use given compiler [Default=stage2]."
200 , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
201 "Configurations to run test, in key=value format."
202 , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")
203 "Output testsuite summary in JUnit format."
204 , Option [] ["only"] (OptArg readTestOnly "TESTS")
205 "Test cases to run."
206 , Option [] ["only-perf"] (NoArg readTestOnlyPerf)
207 "Only run performance tests."
208 , Option [] ["skip-perf"] (NoArg readTestSkipPerf)
209 "Skip performance tests."
210 , Option [] ["test-speed"] (OptArg readTestSpeed "SPEED")
211 "fast, slow or normal. Normal by default"
212 , Option [] ["summary"] (OptArg readTestSummary "TEST_SUMMARY")
213 "Where to output the test summary file."
214 , Option [] ["test-verbose"] (OptArg readTestVerbose "TEST_VERBOSE")
215 "A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output."
216 , Option [] ["test-way"] (OptArg readTestWay "TEST_WAY")
217 "only run these ways" ]
218
219 -- | A type-indexed map containing Hadrian command line arguments to be passed
220 -- to Shake via 'shakeExtra'.
221 cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
222 cmdLineArgsMap = do
223 (opts, _, _) <- getOpt Permute optDescrs <$> getArgs
224 let args = foldl (flip id) defaultCommandLineArgs (rights opts)
225 return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
226 $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
227 $ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities
228 $ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest
229 $ insertExtra args Map.empty
230
231 cmdLineArgs :: Action CommandLineArgs
232 cmdLineArgs = userSetting defaultCommandLineArgs
233
234 cmdConfigure :: Action Bool
235 cmdConfigure = configure <$> cmdLineArgs
236
237 cmdFlavour :: Action (Maybe String)
238 cmdFlavour = flavour <$> cmdLineArgs
239
240 lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot
241 lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs
242
243 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
244 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
245
246 cmdInstallDestDir :: Action (Maybe String)
247 cmdInstallDestDir = installDestDir <$> cmdLineArgs
248
249 cmdIntegerSimple :: Action Bool
250 cmdIntegerSimple = integerSimple <$> cmdLineArgs
251
252 cmdProgressColour :: Action UseColour
253 cmdProgressColour = progressColour <$> cmdLineArgs
254
255 cmdProgressInfo :: Action ProgressInfo
256 cmdProgressInfo = progressInfo <$> cmdLineArgs
257
258 cmdSplitObjects :: Action Bool
259 cmdSplitObjects = splitObjects <$> cmdLineArgs