diff options
| -rw-r--r-- | erebos-tester.cabal | 1 | ||||
| -rw-r--r-- | src/JUnit.hs | 40 | ||||
| -rw-r--r-- | src/Main.hs | 10 |
3 files changed, 50 insertions, 1 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal index a0dd00c..55034fd 100644 --- a/erebos-tester.cabal +++ b/erebos-tester.cabal @@ -39,6 +39,7 @@ executable erebos-tester Asset Config GDB + JUnit Network Network.Ip Output 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 |