Implement report in JUnit XML formatHEADmaster

Changelog: Added `--junit-report` switch to generate test report in JUnit XML format.

2 files changed, 49 insertions, 1 deletions

diff --git a/src/JUnit.hs b/src/JUnit.hs
new file mode 100644
index 0000000..c935987
--- /dev/null
+++ b/src/JUnit.hs
@@ -0,0 +1,40 @@
+module JUnit (
+    writeJUnitReport,
+) where
+
+import Control.Monad
+
+import Data.ByteString qualified as B
+import Data.ByteString.Char8 qualified as BC
+import Data.Function
+import Data.List.NonEmpty qualified as NE
+import Data.Text.Encoding
+
+import System.IO
+
+import Run
+import Script.Var
+
+
+writeJUnitReport :: FilePath -> Report -> IO ()
+writeJUnitReport path Report {..} = withFile path WriteMode $ \h -> do
+    B.hPutStr h $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
+    B.hPutStr h $ "<testsuites time=\"" <> BC.pack (show reportTotalTime) <> "\">\n"
+    forM_ (NE.groupBy ((==) `on` (testNameModule . reportTestName)) reportTests) $ \grp -> do
+        B.hPutStr h $ "<testsuite name=\"" <> encodeUtf8 (textModuleName $ testNameModule $ reportTestName $ NE.head grp) <> "\" time=\"" <> BC.pack (show $ sum $ map reportTime $ NE.toList grp) <> "\">"
+        forM_ grp $ \SingleTestReport {..} -> do
+            B.hPutStr h $ B.concat
+                [ "<testcase name=\"", encodeUtf8 (testNameBase reportTestName), "\""
+                , " classname=\"", encodeUtf8 (textModuleName $ testNameModule reportTestName), "\""
+                , " time=\"", BC.pack (show reportTime), "\""
+                , case reportTestFailed of
+                    Nothing -> do
+                        " />"
+                    Just Failed -> do
+                        "><failure message=\"Test failed\"></failure></testcase>"
+                    Just (ProcessCrashed _) -> do
+                        "><error message=\"Process crashed\"></error></testcase>"
+                ]
+
+        B.hPutStr h $ "</testsuite>"
+    B.hPutStr h $ "</testsuites>\n"
diff --git a/src/Main.hs b/src/Main.hs
index 88fa4ba..3bc9e22 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,6 +21,7 @@ import System.Posix.Terminal
 import System.Posix.Types
 
 import Config
+import JUnit
 import Output
 import Parser.Core
 import Process
@@ -34,6 +35,7 @@ data CmdlineOptions = CmdlineOptions
     , optExclude :: [ Text ]
     , optVerbose :: Bool
     , optReport :: Bool
+    , optJUnitReport :: Maybe FilePath
     , optColor :: Maybe Bool
     , optShowHelp :: Bool
     , optShowVersion :: Bool
@@ -47,6 +49,7 @@ defaultCmdlineOptions = CmdlineOptions
     , optExclude = []
     , optVerbose = False
     , optReport = False
+    , optJUnitReport = Nothing
     , optColor = Nothing
     , optShowHelp = False
     , optShowVersion = False
@@ -103,6 +106,9 @@ options =
     , Option [] [ "report" ]
         (NoArg $ \opts -> opts { optReport = True, optTest = (optTest opts) { optKeepGoing = True } })
         "print summary of passing and failing tests (implies --keep-going)"
+    , Option [] [ "junit-report" ]
+        (ReqArg (\str opts -> opts { optJUnitReport = Just str, optTest = (optTest opts) { optKeepGoing = True } }) "<path>")
+        "write test report in JUnit XML format to <path> (implies --keep-going)"
     , Option [] ["wait"]
         (NoArg $ to $ \opts -> opts { optWait = True })
         "wait at the end of each test"
@@ -216,7 +222,7 @@ main = do
             { optTcpdump = tcpdump
             }
 
-    Report {..} <- runTests out topts lmGlobalDefs tests
+    report@Report {..} <- runTests out topts lmGlobalDefs tests
 
     when (optReport opts) $ flip runReaderT out $ do
         outLineF OutputGlobalSummary Nothing $ "Total tests:  " <> plainText (T.pack (show reportTotalCount))
@@ -241,6 +247,8 @@ main = do
                     withStyle (setForegroundColor Red noStyle) $
                     plainText $ textTestName tname
 
+    forM_ (optJUnitReport opts) $ \path -> writeJUnitReport path report
+
     when (reportFailedCount > 0) exitFailure
 
 exitOnError :: Either CustomTestError a -> IO a