summaryrefslogtreecommitdiff
path: root/src/JUnit.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2026-08-30 20:05:25 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2026-09-03 20:53:42 +0200
commitac8bae764b026def10fa110c675002f14c84860a (patch)
tree6afa7b9b4355d51768a01ca79ee08b4d370d9a1f /src/JUnit.hs
parente1b7b08d398765676a1169fa4a1c0463b19f71d1 (diff)
Implement report in JUnit XML formatHEADmaster
Changelog: Added `--junit-report` switch to generate test report in JUnit XML format.
Diffstat (limited to 'src/JUnit.hs')
-rw-r--r--src/JUnit.hs40
1 files changed, 40 insertions, 0 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"