HUnit-Plus-2.0.0: test/Tests/Test/HUnitPlus/XML.hs
{-# LANGUAGE OverloadedStrings #-}
module Tests.Test.HUnitPlus.XML(tests) where
import Distribution.TestSuite
import Network.HostName
import System.IO.Unsafe
import Test.HUnitPlus.XML
import Text.XML.Expat.Format
import Text.XML.Expat.Tree
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.Text as Strict
import qualified Tests.Test.HUnitPlus.ReporterUtils as Utils
type ReporterState = [[Node Strict.Text Strict.Text]]
type ReporterOp = Utils.ReporterOp ReporterState
countAsserts = Utils.countAsserts
countTried = Utils.countTried
countSkipped = Utils.countSkipped
countErrors = Utils.countErrors
countFailed = Utils.countFailed
setOpt = Utils.setOpt
setName = Utils.setName
pushPath = Utils.pushPath
popPath = Utils.popPath
reportSystemErr = Utils.reportSystemErr xmlReporter
reportSystemOut = Utils.reportSystemOut xmlReporter
reportFailure = Utils.reportFailure xmlReporter
reportError = Utils.reportError xmlReporter
reportSkip = Utils.reportSkip xmlReporter
reportStartCase = Utils.reportStartCase xmlReporter
reportEndCase = Utils.reportEndCase xmlReporter
runReporterTest = Utils.runReporterTest xmlReporter
reportStartSuite = Utils.reportStartSuite xmlReporter
reportEnd = Utils.reportEnd xmlReporter
reportEndSuite :: Double -> ReporterOp
reportEndSuite time state =
let
removeTimestamp ((e @ Element { eAttributes = attrs } : rest) : stack) =
(e { eAttributes = filter ((/= "timestamp") . fst) attrs } : rest) : stack
removeTimestamp out = out
in do
(state, repstate) <- Utils.reportEndSuite xmlReporter time state
return (state, removeTimestamp repstate)
reporterTestCases :: [(String, [ReporterOp], Node Strict.Text Strict.Text)]
reporterTestCases =
[("xmlReporter_systemErr", [reportSystemErr "Error Message Content"],
Element { eName = "system-err", eChildren = [Text "Error Message Content"],
eAttributes = [] }),
("xmlReporter_systemOut", [reportSystemOut "Message Content"],
Element { eName = "system-out", eChildren = [Text "Message Content"],
eAttributes = [] }),
("xmlReporter_failure", [reportFailure "Failure Message"],
Element { eName = "failure", eChildren = [],
eAttributes = [("message", "Failure Message")] }),
("xmlReporter_error", [reportError "Error Message"],
Element { eName = "error", eChildren = [],
eAttributes = [("message", "Error Message")] }),
("xmlReporter_skip", [setName "Test", pushPath "Path", reportSkip],
Element { eName = "testcase",
eChildren = [Element { eName = "skipped",
eAttributes = [],
eChildren = [] }],
eAttributes = [("name", "Test"),
("classname", "Path")] }),
("xmlReporter_empty_case",
[setName "Test", pushPath "Path", pushPath "Inner", reportStartCase,
countAsserts 3, reportEndCase pi],
Element { eName = "testcase", eChildren = [],
eAttributes = [("name", "Test"),
("classname", "Path.Inner"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show pi))] }),
("xmlReporter_output_case",
[setName "Test", pushPath "Path", pushPath "Inner",
reportStartCase, countAsserts 3,
reportSystemErr "Error Message Content", reportSystemOut "Message Content",
reportEndCase pi],
Element { eName = "testcase",
eChildren = [Element { eName = "system-err",
eChildren = [Text "Error Message Content"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Message Content"],
eAttributes = [] }],
eAttributes = [("name", "Test"),
("classname", "Path.Inner"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show pi))] }),
("xmlReporter_failing_case",
[setName "Test", pushPath "Path", pushPath "Inner",
reportStartCase, countAsserts 3,
reportSystemErr "Error Message Content", reportSystemOut "Message Content",
reportFailure "Failure Message", reportEndCase pi],
Element { eName = "testcase",
eChildren = [Element { eName = "system-err",
eChildren = [Text "Error Message Content"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Message Content"],
eAttributes = [] },
Element { eName = "failure", eChildren = [],
eAttributes = [("message",
"Failure Message")] }],
eAttributes = [("name", "Test"),
("classname", "Path.Inner"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show pi))] }),
("xmlReporter_error_case",
[setName "Test", pushPath "Path", pushPath "Inner",
reportStartCase, countAsserts 3,
reportSystemErr "Error Message Content", reportSystemOut "Message Content",
reportError "Error Message", reportEndCase pi],
Element { eName = "testcase",
eChildren = [Element { eName = "system-err",
eChildren = [Text "Error Message Content"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Message Content"],
eAttributes = [] },
Element { eName = "error", eChildren = [],
eAttributes = [("message",
"Error Message")] }],
eAttributes = [("name", "Test"),
("classname", "Path.Inner"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show pi))] }),
("xmlReporter_empty_suite",
[setName "Test", pushPath "Path", reportStartSuite,
countTried 4, countSkipped 3, countErrors 2, countFailed 1,
reportEndSuite pi],
Element { eName = "testsuite", eChildren = [],
eAttributes = [("name", "Test"),
("hostname", Strict.pack hostname),
("time", Strict.pack (show pi)),
("tests", Strict.pack (show 7)),
("failures", Strict.pack (show 1)),
("errors", Strict.pack (show 2)),
("skipped", Strict.pack (show 3))] }),
("xmlReporter_options_suite",
[setName "Test", pushPath "Path", reportStartSuite,
setOpt "option1" "value1", setOpt "option2" "value2",
countTried 4, countSkipped 3, countErrors 2, countFailed 1,
reportEndSuite pi],
Element { eName = "testsuite",
eChildren =
[Element { eName = "properties", eAttributes = [],
eChildren =
[Element { eName = "property", eChildren = [],
eAttributes = [("name", "option1"),
("value", "value1")] },
Element { eName = "property", eChildren = [],
eAttributes = [("name", "option2"),
("value", "value2")] }
] }],
eAttributes = [("name", "Test"),
("hostname", Strict.pack hostname),
("time", Strict.pack (show pi)),
("tests", Strict.pack (show 7)),
("failures", Strict.pack (show 1)),
("errors", Strict.pack (show 2)),
("skipped", Strict.pack (show 3))] }),
("xmlReporter_content_suite",
[setName "Test", pushPath "Path", reportStartSuite,
countTried 4, setName "Pass", reportStartCase, countAsserts 3,
reportSystemErr "Error Message Content", reportSystemOut "Message Content",
reportEndCase (pi - 1),
setName "Skip", pushPath "Inner", reportSkip, countSkipped 1, popPath,
setName "Fail", countErrors 1, reportStartCase, countAsserts 4,
reportFailure "Failure Message", reportEndCase (pi / 2),
setName "Error", countFailed 1, reportStartCase, countAsserts 2,
reportError "Error Message", reportEndCase pi,
reportSystemErr "Suite Error Message", reportSystemOut "Suite Message",
setName "Test", reportEndSuite (pi * pi)],
Element { eName = "testsuite",
eAttributes = [("name", "Test"),
("hostname", Strict.pack hostname),
("time", Strict.pack (show (pi * pi))),
("tests", Strict.pack (show 5)),
("failures", Strict.pack (show 1)),
("errors", Strict.pack (show 1)),
("skipped", Strict.pack (show 1))],
eChildren =
[Element { eName = "testcase",
eChildren =
[Element { eName = "system-err",
eChildren =
[Text "Error Message Content"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Message Content"],
eAttributes = [] }],
eAttributes = [("name", "Pass"),
("classname", "Path"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show (pi - 1)))] },
Element { eName = "testcase",
eChildren = [Element { eName = "skipped",
eAttributes = [],
eChildren = [] }],
eAttributes = [("name", "Skip"),
("classname", "Path.Inner")] },
Element { eName = "testcase",
eChildren =
[Element { eName = "failure", eChildren = [],
eAttributes = [("message",
"Failure Message")] }],
eAttributes = [("name", "Fail"),
("classname", "Path"),
("assertions", Strict.pack (show 4)),
("time", Strict.pack (show (pi / 2)))] },
Element { eName = "testcase",
eChildren =
[Element { eName = "error", eChildren = [],
eAttributes = [("message",
"Error Message")] }],
eAttributes = [("name", "Error"),
("classname", "Path"),
("assertions", Strict.pack (show 2)),
("time", Strict.pack (show pi))] },
Element { eName = "system-err",
eChildren = [Text "Suite Error Message"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Suite Message"],
eAttributes = [] }
] }),
("xmlReporter_empty_suites", [reportEnd pi],
Element { eName = "testsuites", eChildren = [],
eAttributes = [("time", Strict.pack (show pi))] }),
("xmlReporter_content_suites",
[setName "Empty", reportStartSuite,
countTried 5, countSkipped 4, countErrors 2, countFailed 1,
reportEndSuite pi,
setName "Test", pushPath "Path", reportStartSuite,
setOpt "option1" "value1", setOpt "option2" "value2",
countTried 4, setName "Pass", reportStartCase, countAsserts 3,
reportSystemErr "Error Message Content", reportSystemOut "Message Content",
reportEndCase (pi - 1),
setName "Skip", pushPath "Inner", reportSkip, countSkipped 1, popPath,
setName "Fail", countErrors 1, reportStartCase, countAsserts 4,
reportFailure "Failure Message", reportEndCase (pi / 2),
setName "Error", countFailed 1, reportStartCase, countAsserts 2,
reportError "Error Message", reportEndCase pi,
reportSystemErr "Suite Error Message", reportSystemOut "Suite Message",
setName "Test", reportEndSuite (pi * pi), reportEnd (sqrt pi)],
Element {
eName = "testsuites", eAttributes = [("time", Strict.pack (show (sqrt pi)))],
eChildren =
[Element {
eName = "testsuite", eChildren = [],
eAttributes = [("name", "Empty"),
("hostname", Strict.pack hostname),
("time", Strict.pack (show pi)),
("tests", Strict.pack (show 9)),
("failures", Strict.pack (show 1)),
("errors", Strict.pack (show 2)),
("skipped", Strict.pack (show 4))] },
Element {
eName = "testsuite",
eAttributes = [("name", "Test"),
("hostname", Strict.pack hostname),
("time", Strict.pack (show (pi * pi))),
("tests", Strict.pack (show 14)),
("failures", Strict.pack (show 2)),
("errors", Strict.pack (show 3)),
("skipped", Strict.pack (show 5))],
eChildren =
[Element { eName = "properties", eAttributes = [],
eChildren =
[Element { eName = "property", eChildren = [],
eAttributes = [("name", "option1"),
("value", "value1")] },
Element { eName = "property", eChildren = [],
eAttributes = [("name", "option2"),
("value", "value2")] }
] },
Element {
eName = "testcase",
eChildren =
[Element { eName = "system-err",
eChildren =
[Text "Error Message Content"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Message Content"],
eAttributes = [] }],
eAttributes = [("name", "Pass"),
("classname", "Path"),
("assertions", Strict.pack (show 3)),
("time", Strict.pack (show (pi - 1)))] },
Element { eName = "testcase",
eChildren = [Element { eName = "skipped",
eAttributes = [],
eChildren = [] }],
eAttributes = [("name", "Skip"),
("classname", "Path.Inner")] },
Element { eName = "testcase",
eChildren =
[Element { eName = "failure", eChildren = [],
eAttributes = [("message",
"Failure Message")] }],
eAttributes = [("name", "Fail"),
("classname", "Path"),
("assertions", Strict.pack (show 4)),
("time", Strict.pack (show (pi / 2)))] },
Element { eName = "testcase",
eChildren =
[Element { eName = "error", eChildren = [],
eAttributes = [("message",
"Error Message")] }],
eAttributes = [("name", "Error"),
("classname", "Path"),
("assertions", Strict.pack (show 2)),
("time", Strict.pack (show pi))] },
Element { eName = "system-err",
eChildren = [Text "Suite Error Message"],
eAttributes = [] },
Element { eName = "system-out",
eChildren = [Text "Suite Message"],
eAttributes = [] }
] }
] })
]
{-# NOINLINE hostname #-}
hostname :: String
hostname = unsafePerformIO $ getHostName
genReporterTest :: (String, [ReporterOp], Node Strict.Text Strict.Text) -> Test
genReporterTest (name, op, expected) =
let
format :: [[Node Strict.Text Strict.Text]] -> String
format = concat . map (concat . map (BC.unpack . formatNode . indent 2))
out = TestInstance { name = name, tags = [], options = [],
setOption = (\_ _ -> Right out),
run = runReporterTest op [[expected]] format >>=
return . Finished }
in
Test out
tests :: Test
tests = testGroup "XML" (map genReporterTest reporterTestCases)