diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 57 |
1 files changed, 36 insertions, 21 deletions
diff --git a/src/Main.hs b/src/Main.hs index 64741e4..b3f7a2a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,9 +2,9 @@ module Main (main) where import Control.Monad -import Data.Bifunctor import Data.List import Data.Maybe +import Data.Text (Text) import Data.Text qualified as T import Text.Read (readMaybe) @@ -14,14 +14,12 @@ import System.Directory import System.Environment import System.Exit import System.FilePath -import System.FilePath.Glob import System.IO import System.Posix.Terminal import System.Posix.Types import Config import Output -import Parser import Process import Run import Script.Module @@ -33,6 +31,7 @@ import Version data CmdlineOptions = CmdlineOptions { optTest :: TestOptions , optRepeat :: Int + , optExclude :: [ Text ] , optVerbose :: Bool , optColor :: Maybe Bool , optShowHelp :: Bool @@ -44,6 +43,7 @@ defaultCmdlineOptions :: CmdlineOptions defaultCmdlineOptions = CmdlineOptions { optTest = defaultTestOptions , optRepeat = 1 + , optExclude = [] , optVerbose = False , optColor = Nothing , optShowHelp = False @@ -85,6 +85,9 @@ options = , Option ['r'] ["repeat"] (ReqArg (\str opts -> opts { optRepeat = read str }) "<count>") "number of times to repeat the test(s)" + , Option [ 'e' ] [ "exclude" ] + (ReqArg (\str opts -> opts { optExclude = T.pack str : optExclude opts }) "<test>") + "exclude given test from execution" , Option [] ["wait"] (NoArg $ to $ \opts -> opts { optWait = True }) "wait at the end of each test" @@ -107,9 +110,8 @@ hiddenOptions = main :: IO () main = do - configPath <- findConfig - config <- mapM parseConfig configPath - let baseDir = maybe "." dropFileName configPath + config <- mapM parseConfig =<< findConfig + let baseDir = maybe "." configDir config envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool -> return $ fromMaybe (error "No test tool defined") $ mbtool `mplus` (return . (baseDir </>) =<< configTool =<< config) @@ -118,19 +120,26 @@ main = do { optTest = defaultTestOptions { optDefaultTool = envtool , optTestDir = normalise $ baseDir </> optTestDir defaultTestOptions + , optTimeout = fromMaybe (optTimeout defaultTestOptions) $ configTimeout =<< config } } args <- getArgs - (opts, ofiles) <- case getOpt Permute (options ++ hiddenOptions) args of + (opts, oselection) <- case getOpt Permute (options ++ hiddenOptions) args of (o, files, []) -> return (foldl (flip id) initOpts o, files) (_, _, errs) -> do hPutStrLn stderr $ concat errs <> "Try `erebos-tester --help' for more information." exitFailure + let ( ofiles, otests ) + | any (any isPathSeparator) oselection = ( oselection, [] ) + | otherwise = ( [], map T.pack oselection ) + when (optShowHelp opts) $ do let header = unlines - [ "Usage: erebos-tester [<option>...] [<script>[:<test>]...]" + [ "Usage: erebos-tester [<option>...] [<test-name>...]" + , " or: erebos-tester [<option>...] <script>[:<test>]..." + , " <test-name> name of a test from project configuration" , " <script> path to test script file" , " <test> name of the test to run" , "" @@ -144,7 +153,7 @@ main = do exitSuccess when (optTestMode opts) $ do - testMode + testMode config exitSuccess case words $ optDefaultTool $ optTest opts of @@ -158,7 +167,7 @@ main = do case span (/= ':') ofile of (path, ':':test) -> (path, Just $ T.pack test) (path, _) -> (path, Nothing) - else map (, Nothing) . concat <$> mapM (flip globDir1 baseDir) (maybe [] configTests config) + else map (, Nothing) <$> maybe (return []) (getConfigTestFiles) config when (null files) $ fail $ "No test files" @@ -170,22 +179,28 @@ main = do | otherwise = OutputStyleQuiet out <- startOutput outputStyle useColor - ( modules, allModules ) <- parseTestFiles $ map fst files - tests <- forM (zip modules files) $ \( Module {..}, ( filePath, mbTestName )) -> do - case mbTestName of - Nothing -> return moduleTests - Just name - | Just test <- find ((==name) . testName) moduleTests - -> return [ test ] + ( modules, globalDefs ) <- loadModules (map fst files) + tests <- filter ((`notElem` optExclude opts) . testName) <$> if null otests + then fmap concat $ forM (zip modules files) $ \( Module {..}, ( filePath, mbTestName )) -> do + case mbTestName of + Nothing -> return moduleTests + Just name + | Just test <- find ((name ==) . testName) moduleTests + -> return [ test ] + | otherwise + -> do + hPutStrLn stderr $ "Test ‘" <> T.unpack name <> "’ not found in ‘" <> filePath <> "’" + exitFailure + else forM otests $ \name -> if + | Just test <- find ((name ==) . testName) $ concatMap moduleTests modules + -> return test | otherwise -> do - hPutStrLn stderr $ "Test `" <> T.unpack name <> "' not found in `" <> filePath <> "'" + hPutStrLn stderr $ "Test ‘" <> T.unpack name <> "’ not found" exitFailure - let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules - ok <- allM (runTest out (optTest opts) globalDefs) $ - concat $ replicate (optRepeat opts) $ concat tests + concat $ replicate (optRepeat opts) tests when (not ok) exitFailure foreign export ccall testerMain :: IO () |