diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 18 | ||||
| -rw-r--r-- | src/Run.hs | 14 | ||||
| -rw-r--r-- | src/Run/Monad.hs | 4 |
3 files changed, 21 insertions, 15 deletions
diff --git a/src/Main.hs b/src/Main.hs index d3e5ce8..4e73c69 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -28,9 +28,7 @@ import Version data CmdlineOptions = CmdlineOptions { optTest :: TestOptions - , optRepeat :: Int , optExclude :: [ Text ] - , optKeepGoing :: Bool , optVerbose :: Bool , optColor :: Maybe Bool , optShowHelp :: Bool @@ -42,9 +40,7 @@ data CmdlineOptions = CmdlineOptions defaultCmdlineOptions :: CmdlineOptions defaultCmdlineOptions = CmdlineOptions { optTest = defaultTestOptions - , optRepeat = 1 , optExclude = [] - , optKeepGoing = False , optVerbose = False , optColor = Nothing , optShowHelp = False @@ -91,13 +87,13 @@ options = (NoArg $ to $ \opts -> opts { optKeep = True }) "keep test directory even if all tests succeed" , Option ['r'] ["repeat"] - (ReqArg (\str opts -> opts { optRepeat = read str }) "<count>") + (ReqArg (\str -> to $ \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|tag>") "exclude given test or test tag from execution" , Option [] [ "keep-going" ] - (NoArg $ \opts -> opts { optKeepGoing = True }) + (NoArg $ to $ \opts -> opts { optKeepGoing = True }) "keep going after a failed test" , Option [] ["wait"] (NoArg $ to $ \opts -> opts { optWait = True }) @@ -212,15 +208,7 @@ main = do { optTcpdump = tcpdump } - let doRun (t : ts) = do - runTest out topts lmGlobalDefs t >>= \case - True -> doRun ts - False - | optKeepGoing opts -> doRun ts >> return False - | otherwise -> return False - doRun [] = return True - - ok <- doRun $ concat $ replicate (optRepeat opts) tests + ok <- runTests out topts lmGlobalDefs tests when (not ok) exitFailure exitOnError :: Either CustomTestError a -> IO a @@ -1,5 +1,6 @@ module Run ( module Run.Monad, + runTests, runTest, LoadedModules(..), @@ -57,6 +58,19 @@ import Test import Test.Builtins +runTests :: Output -> TestOptions -> GlobalDefs -> [ Test ] -> IO Bool +runTests out opts gdefs tests = do + go $ concat $ replicate (optRepeat opts) tests + where + go (t : ts) = do + runTest out opts gdefs t >>= \case + True -> go ts + False + | optKeepGoing opts -> go ts >> return False + | otherwise -> return False + go [] = return True + + runTest :: Output -> TestOptions -> GlobalDefs -> Test -> IO Bool runTest out opts gdefs test = do let testDir = optTestDir opts </> T.unpack (textModuleName (testModuleName test) <> "." <> testName test) diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index 536038a..efebe05 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -68,6 +68,8 @@ data TestOptions = TestOptions , optGDB :: Bool , optForce :: Bool , optKeep :: Bool + , optRepeat :: Int + , optKeepGoing :: Bool , optWait :: Bool } @@ -81,6 +83,8 @@ defaultTestOptions = TestOptions , optGDB = False , optForce = False , optKeep = False + , optRepeat = 1 + , optKeepGoing = False , optWait = False } |