1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
module Test.Framework.Runners.XML.JUnitWriter (
RunDescription(..),
serialize,
#ifdef TEST
morphFlatTestCase, morphNestedTestCase
#endif
) where
import Test.Framework.Core (TestName)
import Test.Framework.Runners.Core (RunTest(..), FinishedTest)
import Data.List ( intercalate )
import Data.Maybe ( fromMaybe )
import Text.XML.Light ( ppTopElement, unqual, unode
, Attr(..), Element(..) )
-- | An overall description of the test suite run. This is currently
-- styled after the JUnit xml. It contains records that are not yet
-- used, however, it provides a sensible structure to populate as we
-- are able, and the serialiazation code behaves as though these are
-- filled.
data RunDescription = RunDescription {
errors :: Int -- ^ The number of tests that triggered error
-- conditions (unanticipated failures)
, failedCount :: Int -- ^ Count of tests that invalidated stated assertions.
, skipped :: Maybe Int -- ^ Count of tests that were provided but not run.
, hostname :: Maybe String -- ^ The hostname that ran the test suite.
, suiteName :: String -- ^ The name of the test suite.
, testCount :: Int -- ^ The total number of tests provided.
, time :: Double -- ^ The total execution time for the test suite.
, timeStamp :: Maybe String -- ^ The time stamp that identifies when this run happened.
, runId :: Maybe String -- ^ Included for completness w/ junit.
, package :: Maybe String -- ^ holdover from Junit spec. Could be
-- used to specify the module under test.
, tests :: [FinishedTest] -- ^ detailed description and results for each test run.
} deriving (Show)
-- | Serializes a `RunDescription` value to a `String`.
serialize :: Bool -> RunDescription -> String
serialize nested = ppTopElement . toXml nested
-- | Maps a `RunDescription` value to an XML Element
toXml :: Bool -> RunDescription -> Element
toXml nested runDesc = unode "testsuite" (attrs, morph_cases (tests runDesc))
where
morph_cases | nested = map morphNestedTestCase
| otherwise = concatMap (morphFlatTestCase [])
-- | Top-level attributes for the first @testsuite@ tag.
attrs :: [Attr]
attrs = map (\(x,f)->Attr (unqual x) (f runDesc)) fields
fields = [ ("errors", show . errors)
, ("failures", show . failedCount)
, ("skipped", fromMaybe "" . fmap show . skipped)
, ("hostname", fromMaybe "" . hostname)
, ("name", id . suiteName)
, ("tests", show . testCount)
, ("time", show . time)
, ("timeStamp", fromMaybe "" . timeStamp)
, ("id", fromMaybe "" . runId)
, ("package", fromMaybe "" . package)
]
morphFlatTestCase :: [String] -> FinishedTest -> [Element]
morphFlatTestCase path (RunTestGroup gname testList)
= concatMap (morphFlatTestCase (gname:path)) testList
morphFlatTestCase path (RunTest tName _ res) = [morphOneTestCase cName tName res]
where cName | null path = "<none>"
| otherwise = intercalate "." (reverse path)
morphNestedTestCase :: FinishedTest -> Element
morphNestedTestCase (RunTestGroup gname testList) =
unode "testsuite" (attrs, map morphNestedTestCase testList)
where attrs = [ Attr (unqual "name") gname ]
morphNestedTestCase (RunTest tName _ res) = morphOneTestCase "" tName res
morphOneTestCase :: String -> TestName -> (String, Bool) -> Element
morphOneTestCase cName tName (tout, pass) = case pass of
True -> unode "testcase" caseAttrs
False -> unode "testcase" (caseAttrs, unode "failure" (failAttrs, tout))
where caseAttrs = [ Attr (unqual "name") tName
, Attr (unqual "classname") cName
, Attr (unqual "time") ""
]
failAttrs = [ Attr (unqual "message") ""
, Attr (unqual "type") ""
]
|
