Revision ebf38064 htools/test.hs
b/htools/test.hs | ||
---|---|---|
42 | 42 |
-- | Options list and functions. |
43 | 43 |
options :: [OptType] |
44 | 44 |
options = |
45 |
[ oReplay
|
|
46 |
, oVerbose
|
|
47 |
, oShowVer
|
|
48 |
, oShowHelp
|
|
49 |
]
|
|
45 |
[ oReplay |
|
46 |
, oVerbose |
|
47 |
, oShowVer |
|
48 |
, oShowHelp |
|
49 |
] |
|
50 | 50 |
|
51 | 51 |
fast :: Args |
52 | 52 |
fast = stdArgs |
... | ... | |
150 | 150 |
cmd_args <- System.getArgs |
151 | 151 |
(opts, args) <- parseOpts cmd_args "test" options |
152 | 152 |
tests <- (if null args |
153 |
then return allTests |
|
154 |
else (let args' = map lower args |
|
155 |
selected = filter ((`elem` args') . lower . extractName)
|
|
156 |
allTests |
|
157 |
in if null selected |
|
158 |
then do |
|
159 |
hPutStrLn stderr $ "No tests matching '" |
|
160 |
++ intercalate " " args ++ "', available tests: " |
|
161 |
++ intercalate ", " (map extractName allTests) |
|
162 |
exitWith $ ExitFailure 1 |
|
163 |
else return selected)) |
|
153 |
then return allTests
|
|
154 |
else (let args' = map lower args
|
|
155 |
selected = filter ((`elem` args') . lower .
|
|
156 |
extractName) allTests
|
|
157 |
in if null selected
|
|
158 |
then do
|
|
159 |
hPutStrLn stderr $ "No tests matching '"
|
|
160 |
++ intercalate " " args ++ "', available tests: "
|
|
161 |
++ intercalate ", " (map extractName allTests)
|
|
162 |
exitWith $ ExitFailure 1
|
|
163 |
else return selected))
|
|
164 | 164 |
|
165 | 165 |
let max_count = maximum $ map (\(_, (_, t)) -> length t) tests |
166 | 166 |
mapM_ (\(targs, (name, tl)) -> |
167 |
transformTestOpts targs opts >>= \newargs ->
|
|
168 |
runTests name newargs (wrap tl) max_count) tests
|
|
167 |
transformTestOpts targs opts >>= \newargs -> |
|
168 |
runTests name newargs (wrap tl) max_count) tests |
|
169 | 169 |
terr <- readIORef errs |
170 | 170 |
(if terr > 0 |
171 | 171 |
then do |
Also available in: Unified diff