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