packages feed

test-framework 0.4.1 → 0.4.1.1

raw patch · 6 files changed

+43/−22 lines, 6 filesdep ~QuickCheck

Dependency ranges changed: QuickCheck

Files

Test/Framework/Runners/Console.hs view
@@ -63,7 +63,10 @@             "only tests that match at least one glob pattern given by an instance of this argument will be run",         Option [] ["jxml"]             (ReqArg (\t -> mempty { ropt_xml_output = Just (Just t) }) "FILE")-            "write a junit-xml summary of the output to FILE",+            "write a JUnit XML summary of the output to FILE",+        Option [] ["jxml-nested"]+            (NoArg (mempty { ropt_xml_nested = Just True }))+            "use nested testsuites to represent groups in JUnit XML (not standards compliant)",         Option [] ["plain"]             (NoArg (mempty { ropt_plain_output = Just True }))             "do not use any ANSI terminal features to display the test run",@@ -124,7 +127,7 @@          -- Output XML report (if requested)     case ropt_xml_output ropts' of-        K (Just file) -> XML.produceReport test_statistics' fin_tests >>= writeFile file+        K (Just file) -> XML.produceReport (unK (ropt_xml_nested ropts')) test_statistics' fin_tests >>= writeFile file         _ -> return ()          -- Set the error code depending on whether the tests succeded or not@@ -139,6 +142,7 @@             ropt_test_options = K $ ropt_test_options ro `orElse` mempty,             ropt_test_patterns = K $ ropt_test_patterns ro `orElse` mempty,             ropt_xml_output = K $ ropt_xml_output ro `orElse` Nothing,+            ropt_xml_nested = K $ ropt_xml_nested ro `orElse` False,             ropt_plain_output = K $ ropt_plain_output ro `orElse` False,             ropt_hide_successes = K $ ropt_hide_successes ro `orElse` False         }
Test/Framework/Runners/Options.hs view
@@ -14,6 +14,7 @@         ropt_test_options :: f TestOptions,         ropt_test_patterns :: f [TestPattern],         ropt_xml_output :: f (Maybe FilePath),+        ropt_xml_nested :: f Bool,         ropt_plain_output :: f Bool,         ropt_hide_successes :: f Bool     }@@ -24,6 +25,7 @@             ropt_test_options = Nothing,             ropt_test_patterns = Nothing,             ropt_xml_output = Nothing,+            ropt_xml_nested = Nothing,             ropt_plain_output = Nothing,             ropt_hide_successes = Nothing         }@@ -33,6 +35,7 @@             ropt_test_options = mappendBy ropt_test_options ro1 ro2,             ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2,             ropt_xml_output = mappendBy ropt_xml_output ro1 ro2,+            ropt_xml_nested = getLast (mappendBy (Last . ropt_xml_nested) ro1 ro2),             ropt_plain_output = getLast (mappendBy (Last . ropt_plain_output) ro1 ro2),             ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2)         }
Test/Framework/Runners/XML.hs view
@@ -14,8 +14,8 @@ import Network.HostName    ( getHostName )  -produceReport :: TestStatistics -> [FinishedTest] -> IO String-produceReport test_statistics fin_tests = fmap serialize $ mergeResults test_statistics fin_tests+produceReport :: Bool -> TestStatistics -> [FinishedTest] -> IO String+produceReport nested test_statistics fin_tests = fmap (serialize nested) $ mergeResults test_statistics fin_tests   -- | Generates a description of the complete test run, given some
Test/Framework/Runners/XML/JUnitWriter.hs view
@@ -1,13 +1,15 @@ module Test.Framework.Runners.XML.JUnitWriter (         RunDescription(..),-        serialize, toXml,+        serialize, #ifdef TEST-        morphTestCase+        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(..) )@@ -36,13 +38,16 @@   -- | Serializes a `RunDescription` value to a `String`.-serialize :: RunDescription -> String-serialize = ppTopElement . toXml+serialize :: Bool -> RunDescription -> String+serialize nested = ppTopElement . toXml nested  -- | Maps a `RunDescription` value to an XML Element-toXml :: RunDescription -> Element-toXml runDesc = unode "testsuite" (attrs, map morphTestCase $ tests runDesc)+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@@ -58,17 +63,25 @@              , ("package",   fromMaybe "" . package)              ] --- | Generates XML elements for an individual test case or test group.-morphTestCase :: FinishedTest -> Element-morphTestCase (RunTestGroup gname testList) =-  unode "testsuite" (attrs, map morphTestCase testList)+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 -morphTestCase (RunTest tName _ (tout, pass)) = case pass of+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") ""+                    , Attr (unqual "classname") cName                     , Attr (unqual "time") ""                     ]         failAttrs = [ Attr (unqual "message") ""
Test/Framework/Tests.hs view
@@ -9,7 +9,8 @@ -- I wish I could use my test framework to test my framework... main :: IO () main = do-    _ <- runTestTT $ TestList TP.tests-    _ <- runTestTT $ TestList XT.tests-    quickCheck XT.prop_validXml-    return ()+    _ <- runTestTT $ TestList [+    	TestList TP.tests,+    	XT.test+      ]+    quickCheck XT.property
test-framework.cabal view
@@ -1,5 +1,5 @@ Name:                test-framework-Version:             0.4.1+Version:             0.4.1.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.3 && < 2.4,+                Build-Depends:          HUnit >= 1.2, QuickCheck >= 2.3 && < 2.5,                                         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,