Retport summary of test execution

Changelog: Added `--report` command-line option to print summary of passed/failed tests.

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
diff --git a/src/Run.hs b/src/Run.hs
index a253e51..27dc756 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -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)
+                ]