test-framework 0.4.0 → 0.4.1
raw patch · 2 files changed
+11/−43 lines, 2 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
Test/Framework/Runners/XML/JUnitWriter.hs view
@@ -10,7 +10,7 @@ import Data.Maybe ( fromMaybe ) import Text.XML.Light ( ppTopElement, unqual, unode- , Attr(..), Element(..), QName(..), Content(..))+ , Attr(..), Element(..) ) -- | An overall description of the test suite run. This is currently@@ -37,12 +37,11 @@ -- | Serializes a `RunDescription` value to a `String`. serialize :: RunDescription -> String-serialize = ppTopElement . fixClassNames . toXml- where fixClassNames = setAttributeValue (unqual "classname") (setUnsetClassName "<none>")+serialize = ppTopElement . toXml -- | Maps a `RunDescription` value to an XML Element toXml :: RunDescription -> Element-toXml runDesc = unode "testsuite" (attrs, concatMap morphTestCase $ tests runDesc)+toXml runDesc = unode "testsuite" (attrs, map morphTestCase $ tests runDesc) where -- | Top-level attributes for the first @testsuite@ tag. attrs :: [Attr]@@ -60,27 +59,14 @@ ] -- | Generates XML elements for an individual test case or test group.-morphTestCase :: FinishedTest -> [Element]-morphTestCase (RunTestGroup gname testList) = map (setClassName gname) $- concatMap morphTestCase testList- where- setClassName :: String -> Element -> Element- setClassName group e@(Element _ attribs _ _) =- e { elAttribs=setClassAttr group attribs }-- -- | Find the classname attribute and prepend gname to it.- setClassAttr :: String -> [Attr] -> [Attr]- setClassAttr _ [] = []- setClassAttr group (a@(Attr k v):as)- | qName k == "classname" = (Attr k (updateName gname v)):as- | otherwise = a:setClassAttr group as- where- updateName prefix suffix | suffix == "" = prefix- | otherwise = prefix++"."++suffix+morphTestCase :: FinishedTest -> Element+morphTestCase (RunTestGroup gname testList) =+ unode "testsuite" (attrs, map morphTestCase testList)+ where attrs = [ Attr (unqual "name") gname ] morphTestCase (RunTest tName _ (tout, pass)) = case pass of- True -> [unode "testcase" caseAttrs]- False -> [unode "testcase" (caseAttrs, unode "failure" (failAttrs, tout))]+ True -> unode "testcase" caseAttrs+ False -> unode "testcase" (caseAttrs, unode "failure" (failAttrs, tout)) where caseAttrs = [ Attr (unqual "name") tName , Attr (unqual "classname") "" , Attr (unqual "time") ""@@ -88,21 +74,3 @@ failAttrs = [ Attr (unqual "message") "" , Attr (unqual "type") "" ]---- | Sets the specified attributes to the specified value in the given--- @Element@, returning a new Element with the change. This recurses--- deeply through the @Element@, changing all attributes.-setAttributeValue :: QName -> (Attr -> Attr) -> Element -> Element-setAttributeValue aName fn e@(Element _ attribs contents _) = e {- elAttribs = map fn attribs- , elContent = map recurse contents }- where- recurse :: Content -> Content- recurse (Elem el) = Elem $ setAttributeValue aName fn el- -- If content isn't an element, then just return the content as-is:- recurse x = x---- | Sets the attribute value to @newV@ iff the attribute represents a classname.-setUnsetClassName :: String -> Attr -> Attr-setUnsetClassName newV a@(Attr qn v) | qn == (unqual "classname") && v == "" = a { attrVal = newV }- | otherwise = a
test-framework.cabal view
@@ -1,5 +1,5 @@ Name: test-framework-Version: 0.4.0+Version: 0.4.1 Cabal-Version: >= 1.2.3 Category: Testing Synopsis: Framework for running and organising tests, with HUnit and QuickCheck support@@ -78,7 +78,7 @@ if !flag(tests) Buildable: False else- Build-Depends: HUnit >= 1.2, QuickCheck >= 2.1.0.3,+ Build-Depends: HUnit >= 1.2, QuickCheck >= 2.3 && < 2.4, ansi-terminal >= 0.4.0, ansi-wl-pprint >= 0.5.1, regex-posix >= 0.72, extensible-exceptions >= 0.1.1, old-locale >= 1.0, time >= 1.1.2,