diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 17 | ||||
| -rw-r--r-- | src/Run.hs | 41 | ||||
| -rw-r--r-- | src/TestMode.hs | 18 |
3 files changed, 62 insertions, 14 deletions
diff --git a/src/Main.hs b/src/Main.hs index 4e73c69..b6c1078 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -30,6 +30,7 @@ data CmdlineOptions = CmdlineOptions { optTest :: TestOptions , optExclude :: [ Text ] , optVerbose :: Bool + , optReport :: Bool , optColor :: Maybe Bool , optShowHelp :: Bool , optShowVersion :: Bool @@ -42,6 +43,7 @@ defaultCmdlineOptions = CmdlineOptions { optTest = defaultTestOptions , optExclude = [] , optVerbose = False + , optReport = False , optColor = Nothing , optShowHelp = False , optShowVersion = False @@ -95,6 +97,9 @@ options = , Option [] [ "keep-going" ] (NoArg $ to $ \opts -> opts { optKeepGoing = True }) "keep going after a failed test" + , Option [] [ "report" ] + (NoArg $ \opts -> opts { optReport = True, optTest = (optTest opts) { optKeepGoing = True } }) + "print summary of passing and failing tests (implies --keep-going)" , Option [] ["wait"] (NoArg $ to $ \opts -> opts { optWait = True }) "wait at the end of each test" @@ -208,8 +213,16 @@ main = do { optTcpdump = tcpdump } - ok <- runTests out topts lmGlobalDefs tests - when (not ok) exitFailure + Report {..} <- runTests out topts lmGlobalDefs tests + + when (optReport opts) $ do + putStrLn $ "Total: " <> show reportTotalCount + putStrLn $ "Passed: " <> show reportPassedCount + putStrLn $ "Failed: " <> show reportFailedCount + forM_ reportFailedList $ \tname -> do + putStrLn $ T.unpack $ textTestName tname + + when (reportFailedCount > 0) exitFailure exitOnError :: Either CustomTestError a -> IO a exitOnError (Left err) = do @@ -1,5 +1,7 @@ module Run ( module Run.Monad, + Report(..), + TestName, textTestName, runTests, runTest, @@ -58,17 +60,44 @@ import Test import Test.Builtins -runTests :: Output -> TestOptions -> GlobalDefs -> [ Test ] -> IO Bool +data Report = Report + { reportTotalCount :: Int + , reportPassedCount :: Int + , reportSkippedCount :: Int + , reportFailedCount :: Int + , reportFailedList :: [ TestName ] + } + +reportPassed :: Report -> Report +reportPassed r = r + { reportTotalCount = reportTotalCount r + 1 + , reportPassedCount = reportPassedCount r + 1 + } + +reportFailed :: TestName -> Report -> Report +reportFailed tname r = r + { reportTotalCount = reportTotalCount r + 1 + , reportFailedCount = reportFailedCount r + 1 + , reportFailedList = tname : reportFailedList r + } + +runTests :: Output -> TestOptions -> GlobalDefs -> [ Test ] -> IO Report 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 + True -> reportPassed <$> go ts + False -> reportFailed (testName t) <$> if + | optKeepGoing opts -> go ts + | otherwise -> go [] + go [] = return Report + { reportTotalCount = 0 + , reportPassedCount = 0 + , reportSkippedCount = 0 + , reportFailedCount = 0 + , reportFailedList = [] + } runTest :: Output -> TestOptions -> GlobalDefs -> Test -> IO Bool diff --git a/src/TestMode.hs b/src/TestMode.hs index 90ced30..d865384 100644 --- a/src/TestMode.hs +++ b/src/TestMode.hs @@ -78,8 +78,8 @@ getNextTestNumber = do modify $ \s -> s { tmsNextTestNumber = num + 1 } return num -runSingleTest :: Test -> CommandM Bool -runSingleTest test = do +runTestsC :: [ Test ] -> CommandM Report +runTestsC tests = do out <- asks tmiOutput num <- getNextTestNumber Just LoadedModules {..} <- gets tmsModules @@ -88,11 +88,12 @@ runSingleTest test = do { optDefaultTool = fromMaybe "/bin/true" $ configTool =<< mbconfig , optTestDir = ".test" <> show num , optKeep = True + , optKeepGoing = True , optHookTestResult = \tname res -> do flip runReaderT out $ outLine OutputTestRaw Nothing $ "run-test-result " <> testNameBase tname <> " " <> (if res then "done" else "failed") } - liftIO (runTest out opts lmGlobalDefs test) + liftIO (runTests out opts lmGlobalDefs tests) newtype CommandM a = CommandM (ReaderT TestModeInput (StateT TestModeState (ExceptT String IO)) a) @@ -164,6 +165,11 @@ cmdRun = do case filterTests (cfilter <> pfilter) lm of Left err -> showError "run-failed" err Right tests -> do - forM_ tests $ \test -> do - runSingleTest test - cmdOut "run-done" + Report {..} <- runTestsC tests + cmdOut $ T.unwords + [ "run-done" + , T.pack (show reportTotalCount) + , T.pack (show reportPassedCount) + , T.pack (show reportSkippedCount) + , T.pack (show reportFailedCount) + ] |