HUnit-Plus 1.1.0 → 2.0.0

raw patch · 19 files changed

+3877/−428 lines, 19 filesdep +HUnit-Plusdep +textdep +unordered-containersdep −containersPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit-Plus, text, unordered-containers

Dependencies removed: containers

API changes (from Hackage documentation)

Files

• HUnit-Plus.cabal +19/−7
• src/Test/HUnitPlus/Base.hs +123/−94
• src/Test/HUnitPlus/Execution.hs +132/−70
• src/Test/HUnitPlus/Filter.hs +263/−120
• src/Test/HUnitPlus/Main.hs +19/−16
• src/Test/HUnitPlus/Reporting.hs +39/−30
• src/Test/HUnitPlus/Text.hs +73/−50
• src/Test/HUnitPlus/XML.hs +44/−41
• test/Tests.hs +7/−0
• test/Tests/Test.hs +7/−0
• test/Tests/Test/HUnitPlus.hs +15/−0
• test/Tests/Test/HUnitPlus/Base.hs +588/−0
• test/Tests/Test/HUnitPlus/Execution.hs +667/−0
• test/Tests/Test/HUnitPlus/Filter.hs +1006/−0
• test/Tests/Test/HUnitPlus/Main.hs +211/−0
• test/Tests/Test/HUnitPlus/ReporterUtils.hs +194/−0
• test/Tests/Test/HUnitPlus/Reporting.hs +115/−0
• test/Tests/Test/HUnitPlus/Text.hs +7/−0
• test/Tests/Test/HUnitPlus/XML.hs +348/−0

@@ -1,6 +1,6 @@ Name:                   HUnit-Plus Category:               Testing, Test-Version:                1.1.0+Version:                2.0.0 License:                BSD3 License-File:           LICENSE Author:                 Eric McCorkle@@ -34,18 +34,30 @@   default-language:     Haskell2010   type:                 exitcode-stdio-1.0   Main-Is:              RunTests.hs-  hs-source-dirs:       src test+  hs-source-dirs:       test   build-depends:        base >= 4.8 && < 5, Cabal >= 1.16.0, hexpat, timeit,-                        cmdargs, hashable, containers, time, hostname,-                        parsec, bytestring, directory-  ghc-options:          -fhpc+                        cmdargs, hashable, unordered-containers, time,+                        hostname, parsec, text, directory, HUnit-Plus,+                        bytestring+  other-modules:        Tests+                        Tests.Test+                        Tests.Test.HUnitPlus+                        Tests.Test.HUnitPlus.Base+                        Tests.Test.HUnitPlus.Execution+                        Tests.Test.HUnitPlus.Filter+                        Tests.Test.HUnitPlus.Main+                        Tests.Test.HUnitPlus.ReporterUtils+                        Tests.Test.HUnitPlus.Reporting+                        Tests.Test.HUnitPlus.Text+                        Tests.Test.HUnitPlus.XML + Library   default-language:     Haskell2010   hs-source-dirs:       src   build-depends:        base >= 4.8 && < 5, Cabal >= 1.16.0, hexpat, timeit,-                        cmdargs, hashable, containers, time, hostname,-                        bytestring, parsec+                        cmdargs, hashable, unordered-containers, time,+                        hostname, text, parsec, bytestring   exposed-modules:      Test.HUnitPlus.Base                         Test.HUnitPlus.Execution                         Test.HUnitPlus.Filter

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, OverloadedStrings #-}  -- | Basic definitions for the HUnitPlus library. --@@ -67,6 +67,7 @@        (@?),         -- * Low-level Test Functions+       heartbeat,        executeTest,        logSyserr,        logSysout,@@ -89,13 +90,15 @@ import System.TimeIt import Test.HUnitPlus.Reporting +import qualified Data.Text as Strict+ -- | An 'Exception' used to abort test execution immediately. data TestException =   TestException {     -- | Whether this is a failure or an error.     teError :: !Bool,     -- | The failure (or error) message.-    teMsg :: !String+    teMsg :: !Strict.Text   } deriving (Show, Typeable)  instance Exception TestException@@ -107,13 +110,14 @@     -- | Current counts of assertions, tried, failed, and errors.     tiAsserts :: !Word,     -- | Events that have been logged-    tiEvents :: ![(Word, String)],+    tiEvents :: ![(Word, Strict.Text)],     -- | Whether or not the result of the test computation is already     -- reflected here.  This is used to differentiate between black     -- box test and tests we've built with these tools.     tiIgnoreResult :: !Bool,-    -- | String to attach to every failure message as a prefix.-    tiPrefix :: !String+    -- | 'Text' to attach to every failure message as a prefix.+    tiPrefix :: !Strict.Text,+    tiHeartbeat :: !Bool   }  errorCode :: Word@@ -130,7 +134,10 @@  {-# NOINLINE testinfo #-} testinfo :: IORef TestInfo-testinfo = unsafePerformIO $! newIORef undefined+testinfo = unsafePerformIO $! newIORef TestInfo { tiAsserts = 0, tiEvents = [],+                                                  tiIgnoreResult = False,+                                                  tiHeartbeat = False,+                                                  tiPrefix = "" }  -- | Does the actual work of executing a test.  This maintains the -- necessary bookkeeping recording assertions and failures, It also@@ -156,20 +163,21 @@             Just TestException { teError = True, teMsg = msg } ->               do                 logError msg-                return (Finished (Error msg))+                return (Finished (Error (Strict.unpack msg)))             Just TestException { teError = False, teMsg = msg } ->               do                 logFailure msg-                return (Finished (Fail msg))+                return (Finished (Fail (Strict.unpack msg)))             Nothing ->               do                 TestInfo { tiIgnoreResult = ignoreRes } <- readIORef testinfo                 if ignoreRes                   then do-                    logError ("Uncaught exception in test: " ++ show ex)+                    logError (Strict.concat ["Uncaught exception in test: ",+                                             Strict.pack (show ex)])                     return (Finished (Error ("Uncaught exception in test: " ++                                              show ex)))-                  else do+                  else                     return (Finished (Error ("Uncaught exception in test: " ++                                              show ex))) @@ -179,7 +187,7 @@         case progress of           Progress msg nextAction ->             do-              usNext <- reportCaseProgress msg ss us+              usNext <- reportCaseProgress (Strict.pack msg) ss us               finishTestCase (time + inctime) usNext nextAction           Finished res -> return (res, us, time + inctime)   in do@@ -227,32 +235,32 @@     case result of       Error msg | not ignoreRes ->         do-          finalUs <- reportError msg ss eventsUs-          return $! (ss { stCounts =-                             c { cAsserts = asserts + fromIntegral currAsserts,-                                 cCaseAsserts = fromIntegral currAsserts,-                                 cErrors = errors + 1 } },-                    finalUs)+          finalUs <- reportError (Strict.pack msg) ss eventsUs+          return (ss { stCounts =+                         c { cAsserts = asserts + fromIntegral currAsserts,+                             cCaseAsserts = fromIntegral currAsserts,+                             cErrors = errors + 1 } },+                  finalUs)       Fail msg | not ignoreRes ->         do-          finalUs <- reportFailure msg ss eventsUs-          return $! (ss { stCounts =-                            c { cAsserts = asserts + fromIntegral currAsserts,-                                cCaseAsserts = fromIntegral currAsserts,-                                cFailures = failures + 1 } },-                     finalUs)-      _ -> return $! (ss { stCounts =-                             c { cAsserts = asserts + fromIntegral currAsserts,-                                 cCaseAsserts = fromIntegral currAsserts,-                                 cFailures =-                                   if hasFailure-                                     then failures + 1-                                     else failures,-                                 cErrors =-                                   if hasError-                                     then errors + 1-                                     else errors } },-                     eventsUs)+          finalUs <- reportFailure (Strict.pack msg) ss eventsUs+          return (ss { stCounts =+                         c { cAsserts = asserts + fromIntegral currAsserts,+                             cCaseAsserts = fromIntegral currAsserts,+                             cFailures = failures + 1 } },+                  finalUs)+      _ -> return (ss { stCounts =+                          c { cAsserts = asserts + fromIntegral currAsserts,+                              cCaseAsserts = fromIntegral currAsserts,+                              cFailures =+                                if hasFailure+                                  then failures + 1+                                  else failures,+                              cErrors =+                                if hasError+                                  then errors + 1+                                  else errors } },+                   eventsUs)  -- | Indicate that the result of a test is already reflected in the testinfo. ignoreResult :: IO ()@@ -262,27 +270,34 @@ resetTestInfo = writeIORef testinfo TestInfo { tiAsserts = 0,                                                tiEvents = [],                                                tiIgnoreResult = False,+                                               tiHeartbeat = False,                                                tiPrefix = "" } +-- | Indicate test progress.+heartbeat :: IO ()+heartbeat = modifyIORef testinfo (\t -> t { tiHeartbeat = True })+ -- | Execute the given computation with a message prefix.-withPrefix :: String -> IO () -> IO ()+withPrefix :: Strict.Text -> IO () -> IO () withPrefix prefix c =   do     t @ TestInfo { tiPrefix = oldprefix } <- readIORef testinfo-    writeIORef testinfo t { tiPrefix = prefix ++ oldprefix }+    writeIORef testinfo t { tiPrefix = Strict.concat [prefix, oldprefix] }     c     modifyIORef testinfo (\t' -> t' { tiPrefix = oldprefix })  -- | Record sysout output.-logSysout :: String -> IO ()+logSysout :: Strict.Text -> IO () logSysout msg =-  modifyIORef testinfo (\t -> t { tiEvents = (sysOutCode, tiPrefix t ++ msg) :+  modifyIORef testinfo (\t -> t { tiEvents = (sysOutCode,+                                              Strict.concat [tiPrefix t, msg]) :                                              tiEvents t })  -- | Record sysout output.-logSyserr :: String -> IO ()+logSyserr :: Strict.Text -> IO () logSyserr msg =-  modifyIORef testinfo (\t -> t { tiEvents = (sysErrCode, tiPrefix t ++ msg) :+  modifyIORef testinfo (\t -> t { tiEvents = (sysErrCode,+                                              Strict.concat [tiPrefix t, msg]) :                                              tiEvents t })  -- | Record that one assertion has been checked.@@ -290,34 +305,36 @@ logAssert = modifyIORef testinfo (\t -> t { tiAsserts = tiAsserts t + 1 })  -- | Record an error, along with a message.-logError :: String -> IO ()+logError :: Strict.Text -> IO () logError msg =-  modifyIORef testinfo (\t -> t { tiEvents = (errorCode, tiPrefix t ++ msg) :+  modifyIORef testinfo (\t -> t { tiEvents = (errorCode,+                                              Strict.concat [tiPrefix t, msg]) :                                              tiEvents t })  -- | Record a failure, along with a message.-logFailure :: String -> IO ()+logFailure :: Strict.Text -> IO () logFailure msg =-  modifyIORef testinfo (\t -> t { tiEvents = (failureCode, tiPrefix t ++ msg) :+  modifyIORef testinfo (\t -> t { tiEvents = (failureCode,+                                              Strict.concat [tiPrefix t, msg]) :                                              tiEvents t })  -- | Get a combined failure message, if there is one.-getFailures :: IO (Maybe String)+getFailures :: IO (Maybe Strict.Text) getFailures =   do     TestInfo { tiEvents = events } <- readIORef testinfo     case map snd (filter ((== failureCode) . fst) events) of       [] -> return $ Nothing-      fails -> return $ (Just (concat (reverse fails)))+      fails -> return $ Just (Strict.concat (reverse fails))  -- | Get a combined failure message, if there is one.-getErrors :: IO (Maybe String)+getErrors :: IO (Maybe Strict.Text) getErrors =   do     TestInfo { tiEvents = events } <- readIORef testinfo     case map snd (filter ((== errorCode) . fst) events) of       [] -> return $ Nothing-      errors -> return $ (Just (concat (reverse errors)))+      errors -> return $ Just (Strict.concat (reverse errors))  -- Assertion Definition -- ====================@@ -330,7 +347,7 @@ -- | Unconditionally signal that a failure has occurred.  This will -- not stop execution, but will record the failure, resulting in a -- failed test.-assertFailure :: String+assertFailure :: Strict.Text               -- ^ The failure message               -> Assertion assertFailure msg = logAssert >> logFailure msg@@ -341,17 +358,17 @@ assertSuccess = logAssert  -- | Signal than an error has occurred and stop the test immediately.-abortError :: String -> Assertion+abortError :: Strict.Text -> Assertion abortError msg = throw TestException { teError = True, teMsg = msg }  -- | Signal that a failure has occurred and stop the test immediately. -- Note that if an error has been logged already, the test will be -- reported as an error.-abortFailure :: String -> Assertion+abortFailure :: Strict.Text -> Assertion abortFailure msg = throw TestException { teError = False, teMsg = msg }  -- | Asserts that the specified condition holds.-assertBool :: String+assertBool :: Strict.Text            -- ^ The message that is displayed if the assertion fails            -> Bool            -- ^ The condition@@ -361,38 +378,42 @@ -- | Signals an assertion failure if a non-empty message (i.e., a message -- other than @\"\"@) is passed. assertString :: String-             -- ^ The message that is displayed with the assertion failure +             -- ^ The message that is displayed with the assertion failure              -> Assertion assertString = assertStringWithPrefix ""  -- | Signals an assertion failure if a non-empty message (i.e., a -- message other than @\"\"@) is passed.  Allows a prefix to be -- supplied for the assertion failure message.-assertStringWithPrefix :: String+assertStringWithPrefix :: Strict.Text                        -- ^ Prefix to attach to the string if not null                        -> String                        -- ^ String to assert is null                        -> Assertion-assertStringWithPrefix prefix s = assertBool (prefix ++ s) (null s)+assertStringWithPrefix prefix s =+  assertBool (Strict.concat [prefix, Strict.pack s]) (null s)  -- | Asserts that the specified actual value is equal to the expected value.--- The output message will contain the prefix, the expected value, and the +-- The output message will contain the prefix, the expected value, and the -- actual value.---  +-- -- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted -- and only the expected and actual values are output. assertEqual :: (Eq a, Show a)-            => String+            => Strict.Text             -- ^ The message prefix             -> a-            -- ^ The expected value +            -- ^ The expected value             -> a             -- ^ The actual value             -> Assertion assertEqual preface expected actual =   let-    msg = (if null preface then "" else preface ++ "\n") ++-             "expected: " ++ show expected ++ "\nbut got: " ++ show actual+    msg = Strict.concat [if Strict.null preface+                           then ""+                           else Strict.concat [preface, "\n"],+                         "expected: ", Strict.pack (show expected),+                         "\nbut got: ", Strict.pack (show actual)]   in     assertBool msg (actual == expected) @@ -405,11 +426,13 @@                   -> Assertion assertThrowsExact ex comp =   let-    runComp = comp >> assertFailure ("expected exception " ++ show ex ++-                                     " but computation finished normally")+    normalmsg = Strict.concat ["expected exception ", Strict.pack (show ex),+                               " but computation finished normally"]+    runComp = comp >> assertFailure normalmsg     handler ex' =       let-        msg = "expected exception " ++ show ex ++ " but got " ++ show ex'+        msg = Strict.concat ["expected exception ", Strict.pack (show ex),+                             " but got ", Strict.pack (show ex')]       in        if ex == ex'          then assertSuccess@@ -438,12 +461,12 @@ -- ----------------------------  -- | Allows the extension of the assertion mechanism.--- +-- -- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ -- actions, there is a fair amount of flexibility of what can be -- achieved.  As a rule, the resulting 'Assertion' should not assert -- multiple, independent conditions.--- +-- -- If more complex arrangements of assertions are needed, 'Test's and -- 'Testable' should be used. class Assertable t where@@ -458,21 +481,23 @@   assertWithMsg _ = return  instance Assertable Bool where-  assertWithMsg msg = assertBool msg+  assertWithMsg = assertBool . Strict.pack  instance Assertable Result where   assertWithMsg _ Pass = assertSuccess-  assertWithMsg "" (Error errstr) = logError errstr-  assertWithMsg prefix (Error errstr) = logError (prefix ++ errstr)-  assertWithMsg "" (Fail failstr) = assertFailure failstr-  assertWithMsg prefix (Fail failstr) = assertFailure (prefix ++ failstr)+  assertWithMsg "" (Error errstr) = logError (Strict.pack errstr)+  assertWithMsg prefix (Error errstr) =+    logError (Strict.pack (prefix ++ errstr))+  assertWithMsg "" (Fail failstr) = assertFailure (Strict.pack failstr)+  assertWithMsg prefix (Fail failstr) =+    assertFailure (Strict.pack (prefix ++ failstr))  instance Assertable Progress where   assertWithMsg msg (Progress _ cont) = assertWithMsg msg cont   assertWithMsg msg (Finished res) = assertWithMsg msg res  instance (ListAssertable t) => Assertable [t] where-  assertWithMsg msg = listAssert msg+  assertWithMsg = listAssert  instance (Assertable t) => Assertable (IO t) where   assertWithMsg msg t = t >>= assertWithMsg msg@@ -482,10 +507,10 @@   listAssert :: String -> [t] -> Assertion  instance ListAssertable Char where-  listAssert msg = assertStringWithPrefix msg+  listAssert = assertStringWithPrefix . Strict.pack  instance ListAssertable Assertion where-  listAssert msg asserts = withPrefix msg (sequence_ asserts)+  listAssert msg asserts = withPrefix (Strict.pack msg) (sequence_ asserts)  -- Assertion Construction Operators -- --------------------------------@@ -536,12 +561,12 @@ data TestSuite =   TestSuite {     -- | The name of the test suite.-    suiteName :: !String,+    suiteName :: !Strict.Text,     -- | Whether or not to run the tests concurrently.     suiteConcurrently :: !Bool,     -- | A list of all options used by this suite, and the default     -- values for those options.-    suiteOptions :: ![(String, String)],+    suiteOptions :: ![(Strict.Text, Strict.Text)],     -- | The tests in the suite.     suiteTests :: ![Test]   }@@ -553,7 +578,7 @@           -- ^ The tests in the suite.           -> TestSuite testSuite suitename testlist =-  TestSuite { suiteName = suitename, suiteConcurrently = True,+  TestSuite { suiteName = Strict.pack suitename, suiteConcurrently = True,               suiteOptions = [], suiteTests = testlist }  -- Overloaded `test` Function@@ -580,8 +605,8 @@           failures <- getFailures           case failures of             Nothing -> return $ (Finished Pass)-            Just failstr -> return $ (Finished (Fail failstr))-      Just errstr -> return $ (Finished (Error errstr))+            Just failstr -> return $ (Finished (Fail (Strict.unpack failstr)))+      Just errstr -> return $ (Finished (Error (Strict.unpack errstr)))  -- | Provides a way to convert data into a @Test@ or set of @Test@. class Testable t where@@ -590,15 +615,15 @@    -- | Create a test with a given name and no tags from a @Testable@ value   testName :: String -> t -> Test-  testName testname t = testNameTags testname [] t+  testName testname = testNameTags testname []    -- | Create a test with a given name and no tags from a @Testable@ value   testTags :: [String] -> t -> Test-  testTags tagset t = testNameTags syntheticName tagset t+  testTags = testNameTags syntheticName    -- | Create a test with a synthetic name and no tags from a @Testable@ value-  test :: Testable t => t -> Test-  test t = testNameTags syntheticName [] t+  test :: t -> Test+  test = testNameTags syntheticName []  instance Testable Test where   testNameTags newname newtags g @ Group { groupTests = testlist } =@@ -624,9 +649,13 @@  instance (Assertable t) => Testable (IO t) where   testNameTags testname testtags t =-    Test TestInstance { name = testname, tags = testtags,-                        run = wrapTest (t >>= assert),-                        options = [], setOption = undefined }+    let+      unrecognized optname _ = Left ("Unrecognized option " ++ optname)+      out = TestInstance { name = testname, tags = testtags,+                           run = wrapTest (t >>= assert),+                           options = [], setOption = unrecognized }+    in+      Test out  instance (Testable t) => Testable [t] where   testNameTags testname testtags ts =@@ -639,7 +668,7 @@ infix  1 ~?, ~=?, ~?= infixr 0 ~: --- | Creates a test case resulting from asserting the condition obtained +-- | Creates a test case resulting from asserting the condition obtained --   from the specified 'AssertionPredicable'. (~?) :: (Assertable t)      => t@@ -649,31 +678,31 @@      -> Test predi ~? msg = test (predi @? msg) --- | Shorthand for a test case that asserts equality (with the expected +-- | Shorthand for a test case that asserts equality (with the expected --   value on the left-hand side, and the actual value on the right-hand --   side). (~=?) :: (Eq a, Show a)       => a-      -- ^ The expected value +      -- ^ The expected value       -> a       -- ^ The actual value       -> Test expected ~=? actual = test (expected @=? actual) --- | Shorthand for a test case that asserts equality (with the actual +-- | Shorthand for a test case that asserts equality (with the actual --   value on the left-hand side, and the expected value on the right-hand --   side). (~?=) :: (Eq a, Show a)       => a       -- ^ The actual value       -> a-      -- ^ The expected value +      -- ^ The expected value       -> Test actual ~?= expected = test (actual @?= expected) --- | Creates a test from the specified 'Testable', with the specified +-- | Creates a test from the specified 'Testable', with the specified --   label attached to it.--- +-- -- Since 'Test' is @Testable@, this can be used as a shorthand way of -- attaching a 'TestLabel' to one or more tests. (~:) :: (Testable t) => String -> t -> Test

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Functions for executing test cases, test paths, and test suites. -- These functions are provided for the sake of convenience and@@ -14,15 +15,20 @@  import Control.Monad (unless, foldM) import Distribution.TestSuite-import Data.Map(Map)+import Data.HashMap.Strict(HashMap)+import Data.Time+import Data.Version+import Network.HostName import Prelude hiding (elem)+import System.Info import System.TimeIt import Test.HUnitPlus.Base import Test.HUnitPlus.Filter import Test.HUnitPlus.Reporting -import qualified Data.Set as Set-import qualified Data.Map as Map+import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict  -- | Execute an individual test case. performTestCase :: Reporter us@@ -50,26 +56,23 @@     -- Add the name to the state we use to run the tests      -- Update the state before running-    ssWithName = ss { stName = testname, stCounts = c { cTried = tried + 1,-                                                        cCases = cases + 1 } }+    ssWithName = ss { stName = Strict.pack testname,+                      stCounts = c { cTried = tried + 1, cCases = cases + 1 } }      -- Fold function for applying options-    applyOptions (us, ti) OptionDescr { optionName = optname,-                                        optionDefault = def } =+    applyOptions (us, ti) OptionDescr { optionName = optname } =       let         setresult :: Either String TestInstance         setresult =-          case Map.lookup optname optmap of-            Just optval -> setopt optname optval-            Nothing -> case def of-              Just optval -> setopt optname optval-              Nothing -> Right ti+          case HashMap.lookup (Strict.pack optname) optmap of+            Just optval -> setopt optname (Strict.unpack optval)+            Nothing -> Right ti       in case setresult of         Left errmsg ->           do-            newUs <- reportError errmsg ssWithName us-            return $! (newUs, ti)-        Right newTi -> return $! (us, newTi)+            newUs <- reportError (Strict.pack errmsg) ssWithName us+            return (newUs, ti)+        Right newTi -> return (us, newTi)   in do     -- Get all the rest of the information from the resulting test instance     (usOpts, TestInstance { run = runTest }) <-@@ -81,7 +84,7 @@     -- Call the reporters end case function     usEnded <- reportEndCase time ssFinal usFinal     -- Restore the old name before returning-    return $ (ssFinal { stName = oldname }, usEnded)+    return (ssFinal { stName = oldname }, usEnded)  -- | Log a skipped test case. skipTestCase :: Reporter us@@ -100,10 +103,10 @@              TestInstance { name = testname } =   let     ss' = ss { stCounts = c { cSkipped = skipped + 1, cCases = cases + 1 },-               stName = testname }+               stName = Strict.pack testname }   in do     us' <- reportSkipCase ss' us-    return $! (ss' { stName = oldname }, us')+    return (ss' { stName = oldname }, us')  -- | Execute a given test (which may be a group), with the specified -- selector and report generators.  Only tests which match the@@ -119,7 +122,7 @@             -> Test             -- ^ The test to be executed.             -> IO (State, us)-performTest rep initSelector initState initialUs initialTest =+performTest rep initSelector initialState initialUs initialTest =   let     -- The recursive worker function that actually runs all the tests     --@@ -129,17 +132,18 @@     --     -- We also have to keep a set of tags by which we're filtering.     -- The empty tag set means we don't actually filter at all.-    performTest' Selector { selectorInners = inners, selectorTags = currtags }+    performTest' s @ Selector { selectorInners = inners,+                                selectorTags = currtags }                  ss us Group { groupTests = testlist, groupName = gname } =       let         -- Build the new selector         selector' =           -- Try looking up the group in the inners-          case Map.lookup gname inners of+          case HashMap.lookup (Strict.pack gname) inners of             -- If we don't find anything, we can only keep executing             -- if our tag state allows it.-            Nothing -> Selector { selectorInners = Map.empty,-                                  selectorTags = currtags }+            Nothing -> s { selectorInners = HashMap.empty,+                           selectorTags = currtags }             -- Otherwise, combine the inner's tag state with ours and             -- carry on.             Just inner @ Selector { selectorTags = innertags } ->@@ -147,14 +151,14 @@          -- Update the path for running the group's tests         oldpath = stPath ss-        ssWithPath = ss { stPath = Label gname : oldpath }+        ssWithPath = ss { stPath = Label (Strict.pack gname) : oldpath } -        foldfun (ss', us') t = performTest' selector' ss' us' t+        foldfun (ss', us') = performTest' selector' ss' us'       in do         -- Run the tests with the updated path         (ssAfter, usAfter) <- foldM foldfun (ssWithPath, us) testlist         -- Return the state, reset to the old path-        return $! (ssAfter { stPath = oldpath }, usAfter)+        return (ssAfter { stPath = oldpath }, usAfter)     performTest' Selector { selectorInners = inners, selectorTags = currtags }                  ss us (Test t @ TestInstance { name = testname,                                                 tags = testtags }) =@@ -162,7 +166,7 @@         -- Get the final tag state         finaltags =           -- Try looking up the group in the inners-          case Map.lookup testname inners of+          case HashMap.lookup (Strict.pack testname) inners of             -- If we don't find anything, we can only keep executing             -- if our tag state allows it.             Nothing -> currtags@@ -175,8 +179,9 @@           case finaltags of             Nothing -> False             Just set-              | set == Set.empty -> True-              | otherwise -> any (\tag -> Set.member tag set) testtags+              | HashSet.null set -> True+              | otherwise -> any (\tag -> HashSet.member tag set)+                                 (map Strict.pack testtags)       in         if canExecute           then performTestCase rep ss us t@@ -185,45 +190,100 @@                  us (ExtraOptions newopts inner) =       performTest' selector ss { stOptionDescs = descs ++ newopts } us inner   in do-    (ss', us') <- performTest' initSelector initState initialUs initialTest+    (ss', us') <- performTest' initSelector initialState initialUs initialTest     unless (null (stPath ss')) $ error "performTest: Final path is nonnull"-    return $! (ss', us')+    return (ss', us') +-- | Run a test suite with a given set of options.+performTestSuiteInstance :: Reporter us+                         -- ^ Report generator to use for running the+                         -- test suite.+                         -> OptionMap+                         -- ^ The options for this instance.+                         -> Selector+                         -- ^ The selector to use.+                         -> State+                         -- ^ HUnit-Plus internal state.+                         -> us+                         -- ^ State for the report generator.+                         -> TestSuite+                         -- ^ Test suite to be run.+                         -> IO (State, us)+performTestSuiteInstance rep @ Reporter { reporterStartSuite = reportStartSuite,+                                          reporterEndSuite = reportEndSuite }+                         instopts selector+                         st @ State { stOptions = stopts } initialUs+                         TestSuite { suiteName = sname, suiteTests = testlist,+                                     suiteOptions = suiteOpts } =+  let+    makestate timestamp =+      let+        timestr = formatTime defaultTimeLocale "%c" timestamp+        withtime = HashMap.insert "timestamp" (Strict.pack timestr) stopts+        -- Don't allow people to override the system information+        withInstOpts = HashMap.union withtime instopts+        unioned = HashMap.union withInstOpts (HashMap.fromList suiteOpts)+      in+        return st { stOptions = unioned, stName = sname }++    foldfun (c, us) = performTest rep selector c us+  in do+    timestamp <- getCurrentTime+    state <- makestate timestamp+    startedUs <- reportStartSuite state initialUs+    (time, (finishedState @ State { stCounts = counts }, finishedUs)) <-+      timeItT (foldM foldfun (state, startedUs) testlist)+    endedUs <- reportEndSuite time finishedState finishedUs+    return (finishedState { stCounts = counts { cCaseAsserts = 0 } },+            endedUs)+ -- | Decide whether to execute a test suite based on a map from suite -- names to selectors.  If the map contains a selector for the test -- suite, execute all tests matching the selector, and log the rest as -- skipped.  If the map does not contain a selector, do not execute -- the suite, and do /not/ log its tests as skipped.+performTestSuiteInternal :: Reporter us+                         -- ^ Report generator to use for running the+                         -- test suite.+                         -> HashMap Strict.Text (HashMap OptionMap Selector)+                         -- ^ The map containing selectors for each suite.+                         -> State+                         -- ^ HUnit-Plus internal state.+                         -> us+                         -- ^ State for the report generator.+                         -> TestSuite+                         -- ^ Test suite to be run.+                         -> IO (State, us)+performTestSuiteInternal rep filters initialSs initialUs+                         suite @ TestSuite { suiteName = sname } =+  case HashMap.lookup sname filters of+    Just optmap ->+      let+        foldfun (ss, us) (opts, selector) =+          performTestSuiteInstance rep opts selector ss us suite+      in+        foldM foldfun (initialSs, initialUs) (HashMap.toList optmap)+    _ -> return (initialSs, initialUs)++initState :: State+initState = State { stCounts = zeroCounts, stName = "",+                    stPath = [], stOptions = HashMap.empty,+                    stOptionDescs = [] }+ performTestSuite :: Reporter us                  -- ^ Report generator to use for running the test suite.-                 -> Map String Selector+                 -> HashMap Strict.Text (HashMap OptionMap Selector)                  -- ^ The map containing selectors for each suite.                  -> us                  -- ^ State for the report generator.                  -> TestSuite                  -- ^ Test suite to be run.                  -> IO (Counts, us)-performTestSuite rep @ Reporter { reporterStartSuite = reportStartSuite,-                                  reporterEndSuite = reportEndSuite }-                 filters initialUs-                 TestSuite { suiteName = sname, suiteTests = testlist,-                             suiteOptions = suiteOpts } =-  case Map.lookup sname filters of-    Just selector ->-      let-        initState = State { stCounts = zeroCounts, stName = sname,-                            stPath = [], stOptions = Map.fromList suiteOpts,-                            stOptionDescs = [] }--        foldfun (c, us) testcase = performTest rep selector c us testcase-      in do-        startedUs <- reportStartSuite initState initialUs-        (time, (finishedState, finishedUs)) <--          timeItT (foldM foldfun (initState, startedUs) testlist)-        endedUs <- reportEndSuite time finishedState finishedUs-        return $! (stCounts finishedState, endedUs)-    _ ->-      return $! (zeroCounts, initialUs)+performTestSuite rep filters us suite =+  do+    (State { stCounts = out }, _) <-+      performTestSuiteInternal rep filters initState us suite+    return (out, us)  -- | Top-level function for a test run.  Given a set of suites and a -- map from suite names to selectors, execute all suites that have@@ -233,7 +293,7 @@ -- their tests will /not/ be logged as skipped. performTestSuites :: Reporter us                   -- ^ Report generator to use for running the test suite.-                  -> Map String Selector+                  -> HashMap Strict.Text (HashMap OptionMap Selector)                   -- ^ The processed filter to use.                   -> [TestSuite]                   -- ^ Test suite to be run.@@ -242,24 +302,26 @@                                    reporterEnd = reportEnd }                   filters suites =   let-    combineCounts Counts { cCases = cases1, cTried = tried1,-                           cErrors = errors1, cFailures = failures1,-                           cAsserts = asserts1, cSkipped = skipped1 }-                  Counts { cCases = cases2, cTried = tried2,-                           cErrors = errors2, cFailures = failures2,-                           cAsserts = asserts2, cSkipped = skipped2 } =-      Counts { cCases = cases1 + cases2, cTried = tried1 + tried2,-               cErrors = errors1 + errors2, cFailures = failures1 + failures2,-               cAsserts = asserts1 + asserts2, cSkipped = skipped1 + skipped2,-               cCaseAsserts = 0 }+    foldfun (accumState, accumUs) =+      performTestSuiteInternal rep filters accumState accumUs -    foldfun (accumCounts, accumUs) suite =+    startstate =       do-        (suiteCounts, suiteUs) <- performTestSuite rep filters accumUs suite-        return $! (combineCounts accumCounts suiteCounts, suiteUs)+        hostname <- getHostName+        return initState {+                 stOptions = HashMap.fromList+                               [("hostname", Strict.pack hostname),+                                ("os", Strict.pack os),+                                ("arch", Strict.pack arch),+                                ("compiler-name",+                                 Strict.pack compilerName),+                                ("compiler-version",+                                 Strict.pack (showVersion compilerVersion))]+               }   in do     initialUs <- reportStart-    (time, (finishedCounts, finishedUs)) <--      timeItT (foldM foldfun (zeroCounts, initialUs) suites)+    st <- startstate+    (time, (State { stCounts = finishedCounts }, finishedUs)) <-+      timeItT (foldM foldfun (st, initialUs) suites)     endedUs <- reportEnd time finishedCounts finishedUs-    return $! (finishedCounts, endedUs)+    return (finishedCounts, endedUs)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}  -- | Sets HUnit-Plus tests can be specified using 'Filter's.  These@@ -16,9 +17,10 @@ -- -- The format for filters is as follows: ----- \[/suite/\]\[/path/\]\[/tags/\]+-- > [suite][path][tags][options] ----- Where at least one of the /suite/, /path/, or /tags/ elements are present+-- Where at least one of the /suite/, /path/, /tags/, or /options/+-- elements are present -- -- The /suite/ element is a comma-separated list of suite names (alphanumeric, -- no spaces), enclosed in brackets ('[' ']').@@ -26,9 +28,12 @@ -- The /path/ element is a series of path elements (alphanumeric, no -- spaces), separated by dots ('.'). ----- The /tags/ element consists of a '\@' character, followed by a+-- The /tags/ element consists of a '@' character, followed by a -- comma-separated list of tag names (alphanumeric, no spaces). --+-- The /options/ element consists of a '?' character, followed by a+-- comma-separated list of \"name\"=\"value\" bindings.+-- -- The following are examples of textual filters, and their meanings: -- -- * @first.second.third@: Run all tests starting with the path@@ -55,12 +60,25 @@ --   'whitebox' suite beginning with the path @network.protocol@ that --   have the 'security' tag. --+-- * @first.second.third?\"var\"=\"val\"@: Run all tests starting with the path+--   @first.second.third@, with the option \"var\" set to \"val\".+--+-- * @[unit]?\"timeout\"=\"5\"@: Run all tests in the suite 'unit'+--   with the option \"timeout\" set to \"\5".+--+-- * @[system]?\"timeout\"=\"5\",\"threads\"=\"4\"@: Run all tests in+-- the suite 'system' with the option 'timeout' set to '5' and+-- 'threads' set to '4'.+--+-- * ?\"user\"=\"jeffk\": Run all tests with the 'user' option set to 'jeffk'.+-- -- The most common use case of filters is to select a single failing -- test to run, as part of fixing it.  In this case, a single filter -- consisting of the path to the test will have this effect. module Test.HUnitPlus.Filter(        Selector(..),        Filter(..),+       OptionMap,        combineTags,        passFilter,        allSelector,@@ -74,16 +92,23 @@ import Control.Exception import Data.Foldable(foldl) import Data.Either-import Data.Map(Map)+import Data.Hashable+import Data.HashMap.Strict(HashMap) import Data.Maybe-import Data.Set(Set)+import Data.HashSet(HashSet)+import Data.List(sort) import Prelude hiding (foldl, elem) import System.IO.Error-import Text.ParserCombinators.Parsec hiding (try)+import Text.Parsec hiding (try)+import Text.Parsec.Text -import qualified Data.Set as Set-import qualified Data.Map as Map+import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict+import qualified Data.Text.IO as Strict +type OptionMap = HashMap Strict.Text Strict.Text+ -- | A tree-like structure that represents a set of tests within a -- given suite. data Selector =@@ -92,14 +117,14 @@       -- path element contains the @Selector@ to be used for that       -- group (or test).  An empty map actually means 'select all       -- tests'.-      selectorInners :: Map String Selector,+      selectorInners :: HashMap Strict.Text Selector,       -- | Tags by which to filter all tests.  The empty set actually       -- means 'run all tests regardless of tags'.  'Nothing' means       -- that all tests will be skipped (though this will be       -- overridden by any @Selector@s in @selectorInners@.-      selectorTags :: !(Maybe (Set String))+      selectorTags :: !(Maybe (HashSet Strict.Text))     }-    deriving (Eq, Ord, Show)+    deriving (Eq, Show)  -- | Specifies zero or more test suites, to which the given 'Selector' -- is then applied.  If no test suites are specified, then the@@ -108,75 +133,126 @@   Filter {     -- | The test suites to which the 'Selector' applies.  The empty     -- set actually means 'all suites'.-    filterSuites :: !(Set String),+    filterSuites :: !(HashSet Strict.Text),     -- | The 'Selector' to apply.-    filterSelector :: !Selector+    filterSelector :: !(HashSet Selector),+    filterOptions :: !(HashMap Strict.Text Strict.Text)   }-  deriving (Ord, Eq, Show)+  deriving (Eq, Show) +instance Ord Selector where+  compare Selector { selectorInners = inners1, selectorTags = Just tags1 }+          Selector { selectorInners = inners2, selectorTags = Just tags2 } =+    let+      sortedtags1 = sort (HashSet.toList tags1)+      sortedtags2 = sort (HashSet.toList tags2)+      sortedinners1 = sort (HashMap.toList inners1)+      sortedinners2 = sort (HashMap.toList inners2)+    in+      case compare sortedtags1 sortedtags2 of+        EQ -> compare sortedinners1 sortedinners2+        out -> out+  compare Selector { selectorTags = Nothing }+          Selector { selectorTags = Just _ } = LT+  compare Selector { selectorTags = Just _ }+          Selector { selectorTags = Nothing } = GT+  compare Selector { selectorInners = inners1, selectorTags = Nothing }+          Selector { selectorInners = inners2, selectorTags = Nothing } =+    let+      sortedinners1 = sort (HashMap.toList inners1)+      sortedinners2 = sort (HashMap.toList inners2)+    in+      compare sortedinners1 sortedinners2++instance Hashable Selector where+  hashWithSalt s Selector { selectorInners = inners,+                            selectorTags = Just tags } =+    let+      sortedtags = sort (HashSet.toList tags)+      sortedinners = sort (HashMap.toList inners)+    in+      s `hashWithSalt` sortedinners `hashWithSalt` sortedtags+  hashWithSalt s Selector { selectorInners = inners,+                            selectorTags = Nothing } =+    let+      sortedinners = sort (HashMap.toList inners)+    in+      s `hashWithSalt` sortedinners+ -- | Combine two 'selectorTags' fields into one.  This operation represents the -- union of the tests that are selected by the two fields.-combineTags :: Maybe (Set String) -> Maybe (Set String) -> Maybe (Set String)+combineTags :: Maybe (HashSet Strict.Text) -> Maybe (HashSet Strict.Text) ->+               Maybe (HashSet Strict.Text) -- Nothing means we can't execute, so if the other side says we can, -- we can. combineTags Nothing t = t combineTags t Nothing = t combineTags (Just a) (Just b)   -- The empty set means we execute everything, so it absorbs-  | a == Set.empty || b == Set.empty = Just $! Set.empty+  | HashSet.null a || HashSet.null b = Just $! HashSet.empty   -- Otherwise, we do set union-  | otherwise = Just $! Set.union a b+  | otherwise = Just $! HashSet.union a b  -- | Take the difference of one set of tags from another.-diffTags :: Maybe (Set String) -> Maybe (Set String) -> Maybe (Set String)+diffTags :: Maybe (HashSet Strict.Text) -> Maybe (HashSet Strict.Text) ->+            Maybe (HashSet Strict.Text) -- Nothing means we can't execute, so if the other side says we can, -- we can. diffTags Nothing _ = Nothing diffTags t Nothing = t diffTags (Just a) (Just b)-  | a == Set.empty = Just Set.empty-  | b == Set.empty = Nothing+  | HashSet.null a = Just HashSet.empty+  | HashSet.null b = Nothing   -- Otherwise, we do set union   | otherwise =     let-      diff = Set.difference a b+      diff = HashSet.difference a b     in-      if diff == Set.empty+      if diff == HashSet.empty         then Nothing         else Just $! diff  -- | A 'Filter' that selects all tests in all suites. passFilter :: Filter-passFilter = Filter { filterSuites = Set.empty, filterSelector = allSelector }+passFilter = Filter { filterSuites = HashSet.empty,+                      filterSelector = HashSet.singleton allSelector,+                      filterOptions = HashMap.empty }  -- | A 'Selector' that selects all tests. allSelector :: Selector-allSelector = Selector { selectorInners = Map.empty,-                         selectorTags = Just Set.empty }+allSelector = Selector { selectorInners = HashMap.empty,+                         selectorTags = Just HashSet.empty } -reduceSelector :: Maybe (Set String) -> Selector -> Maybe Selector-reduceSelector parentTags Selector { selectorInners = inners,-                                     selectorTags = tags } =+noOptionsAllSelector :: HashMap OptionMap Selector+noOptionsAllSelector = HashMap.singleton HashMap.empty allSelector++-- | Eliminate redundant nested tags from a Selector.+reduceSelector :: Maybe (HashSet Strict.Text) -> Selector -> Maybe Selector+reduceSelector parentTags s @ Selector { selectorInners = inners,+                                         selectorTags = tags } =   let     newTags = diffTags tags parentTags     newParentTags = combineTags parentTags tags-    newInners = Map.mapMaybe (reduceSelector newParentTags) inners+    newInners = HashMap.mapMaybe (reduceSelector newParentTags) inners   in-    if newTags == Nothing && newInners == Map.empty+    -- This selector goes away if we eliminate all inners and all tags+    if isNothing newTags && HashMap.null newInners       then Nothing-      else Just $! Selector { selectorInners = inners, selectorTags = tags }+      else Just $! s { selectorInners = inners, selectorTags = tags }  -- | Combine two 'Selector's into a single 'Selector'. combineSelectors :: Selector -> Selector -> Selector combineSelectors selector1 selector2 =   let-    combineSelectors' :: Maybe (Set String) -> Selector -> Selector ->-                         Maybe Selector-    combineSelectors' parentTags-                      s1 @ Selector { selectorInners = inners1,-                                      selectorTags = tags1 }-                      s2 @ Selector { selectorInners = inners2,-                                      selectorTags = tags2 }+    tryCombineSelectors :: Maybe (HashSet Strict.Text) ->+                           Selector -> Selector ->+                           Maybe Selector+    tryCombineSelectors parentTags+                        s1 @ Selector { selectorInners = inners1,+                                        selectorTags = tags1 }+                        s2 @ Selector { selectorInners = inners2,+                                        selectorTags = tags2 }+        -- Short-circuit case for allSelector.       | s1 == allSelector || s2 == allSelector = Just allSelector       | otherwise =         let@@ -184,150 +260,213 @@           newTags = diffTags combinedTags parentTags           newParentTags = combineTags combinedTags parentTags -          firstpass :: Map String Selector -> String -> Selector ->-                       Map String Selector+          -- | First pass: pull in everything from inners2.  This will+          -- combine everything that can be combined and attempt to+          -- reduce the rest.+          firstpass :: HashMap Strict.Text Selector ->+                       Strict.Text -> Selector ->+                       HashMap Strict.Text Selector           firstpass accum elem inner =-            case Map.lookup elem inners1 of-              Just inner' -> case combineSelectors' newParentTags inner inner' of-                Just entry -> Map.insert elem entry accum-                Nothing -> accum+            case HashMap.lookup elem inners1 of+              -- If it exists in both, try to combine.+              Just inner' ->+                case tryCombineSelectors newParentTags inner inner' of+                -- If we get back an entry, insert it.+                  Just entry -> HashMap.insert elem entry accum+                  -- We might have reduced it to nothing.+                  Nothing -> accum+              -- Otherwise, attempt to reduce.               Nothing -> case reduceSelector newParentTags inner of-                Just entry -> Map.insert elem entry accum+                -- If we get back an entry, insert it.+                Just entry -> HashMap.insert elem entry accum+                -- If we reduce it to nothing, leave it out.                 Nothing -> accum -          secondpass :: Map String Selector -> String -> Selector ->-                        Map String Selector+          -- | Second pass: pull in everything from inners1.+          secondpass :: HashMap Strict.Text Selector ->+                        Strict.Text -> Selector ->+                        HashMap Strict.Text Selector           secondpass accum elem inner =-            case Map.lookup elem accum of-              Nothing -> case reduceSelector newParentTags inner of-                Just entry -> Map.insert elem entry accum-                Nothing -> accum+            case HashMap.lookup elem accum of+              -- If there's nothing there, it means we either had+              -- nothing, or we combined and reduced to nothing in the+              -- first pass.+              Nothing -> case HashMap.lookup elem inners2 of+                -- If we find an entry in inners2, then we combined+                -- and reduced to nothing.+                Just _ -> accum+                -- Otherwise, try to reduce the entry and insert it+                Nothing -> case reduceSelector newParentTags inner of+                  Just entry -> HashMap.insert elem entry accum+                  Nothing -> accum+              -- If there's something already there, it's because we+              -- combined successfully in the first pass.               Just _ -> accum -          firstPassMap = Map.foldlWithKey firstpass Map.empty inners2-          newInners = Map.foldlWithKey secondpass firstPassMap inners1+          firstPassMap = HashMap.foldlWithKey' firstpass HashMap.empty inners2+          newInners = HashMap.foldlWithKey' secondpass firstPassMap inners1         in-          if newTags == Nothing && newInners == Map.empty+          if isNothing newTags && HashMap.null newInners             then Nothing             else Just $! Selector { selectorInners = newInners,                                     selectorTags = newTags }-  in-    case combineSelectors' Nothing selector1 selector2 of+  in case tryCombineSelectors Nothing selector1 selector2 of       Just out -> out       Nothing -> error ("Got Nothing back from combineSelectors " ++                         show selector1 ++ " " ++ show selector2)  -- | Collect all the selectors from filters that apply to all suites.-collectUniversals :: Filter -> Set Selector -> Set Selector+collectUniversals :: Filter+                  -> HashMap OptionMap (HashSet Selector)+                  -> HashMap OptionMap (HashSet Selector) collectUniversals Filter { filterSuites = suites,+                           filterOptions = options,                            filterSelector = selector } accum-  | suites == Set.empty = Set.insert selector accum+  | HashSet.null suites =+    HashMap.insertWith HashSet.union options selector accum   | otherwise = accum  -- | Build a map from suite names to the selectors that get run on them. collectSelectors :: Filter                  -- ^ The current filter-                 -> Map String (Set Selector)-                 -- ^ The map from suites to -                 -> Map String (Set Selector)-collectSelectors Filter { filterSuites = suites, filterSelector = selector }-                 suitemap =-    foldl (\suitemap' suite -> Map.insertWith Set.union suite-                                              (Set.singleton selector)-                                              suitemap')-          suitemap suites+                 -> HashMap Strict.Text (HashMap OptionMap (HashSet Selector))+                 -- ^ The map from suites to sets of selectors that+                 -- run on them.+                 -> HashMap Strict.Text (HashMap OptionMap (HashSet Selector))+collectSelectors Filter { filterSuites = suites, filterOptions = options,+                          filterSelector = selector } suitemap =+  let+    foldfun accum suite =+      HashMap.insertWith (HashMap.unionWith HashSet.union) suite+                         (HashMap.singleton options selector) accum+  in+    foldl foldfun suitemap suites  -- | Take a list of test suite names and a list of 'Filter's, and--- build a 'Map' that says for each test suite, what (combined)+-- build a 'HashMap' that says for each test suite, what (combined) -- 'Selector' should be used to select tests.-suiteSelectors :: [String]+suiteSelectors :: [Strict.Text]                -- ^ The names of all test suites.                -> [Filter]                -- ^ The list of 'Filter's from which to build the map.-               -> Map String Selector+               -> HashMap Strict.Text (HashMap OptionMap Selector) suiteSelectors allsuites filters   -- Short-circuit case if we have no filters, we run everything-  | filters == [] =-    foldl (\suitemap suite -> Map.insert suite allSelector suitemap)-          Map.empty allsuites+  | null filters =+    foldl (\suitemap suite -> HashMap.insert suite noOptionsAllSelector+                                             suitemap)+          HashMap.empty allsuites   | otherwise =     let       -- First, pull out all the universals-      universals = foldr collectUniversals Set.empty filters+      universals = foldr collectUniversals HashMap.empty filters       -- If we have any universals, then seed the initial map with them,       -- otherwise, use the empty map.       initMap =-        if universals /= Set.empty-          then foldl (\suitemap suite -> Map.insert suite universals suitemap)-                     Map.empty allsuites-          else Map.empty+        if not (HashMap.null universals)+          then foldl (\suitemap suite ->+                       HashMap.insert suite universals suitemap)+                     HashMap.empty allsuites+          else HashMap.empty        -- Now collect all the suite-specific selectors-      suiteMap :: Map String (Set Selector)+      suiteMap :: HashMap Strict.Text (HashMap OptionMap (HashSet Selector))       suiteMap = foldr collectSelectors initMap filters     in-      Map.map (foldl1 combineSelectors . Set.elems) suiteMap+      HashMap.map (HashMap.map (foldl1 combineSelectors . HashSet.toList))+                  suiteMap -nameParser :: GenParser Char st Char+nameParser :: Parser Strict.Text nameParser =-  oneOf "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-_"+  do+    out <- many1 (oneOf ("abcdefghijklmnopqrstuvwxyz" +++                         "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-_"))+    return $! Strict.pack out -namesParser :: GenParser Char st [String]-namesParser = sepBy1 (many1 nameParser) (string ",")+valueParser :: Parser Strict.Text+valueParser =+  do+    out <- between (char '\"') (char '\"')+                   (many1 (oneOf ("abcdefghijklmnopqrstuvwxyz" +++                                 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" +++                                 "~!@#$%^&*()[]{}<>:;,\'.+=-_?/\\|")))+    return $! Strict.pack out -pathParser :: GenParser Char st [String]-pathParser = sepBy (many1 nameParser) (string ".") -suitesParser :: GenParser Char st [String]+optionParser :: Parser (Strict.Text, Strict.Text)+optionParser =+  do+    key <- valueParser+    _ <- char '='+    val <- valueParser+    return (key, val)++optionsParser :: Parser [(Strict.Text, Strict.Text)]+optionsParser = char '?' >> many1 optionParser++namesParser :: Parser [Strict.Text]+namesParser = sepBy1 nameParser (string ",")++pathParser :: Parser [Strict.Text]+pathParser = sepBy nameParser (string ".")++suitesParser :: Parser [Strict.Text] suitesParser = between (string "[") (string "]") namesParser -tagsParser :: GenParser Char st [String]+tagsParser :: Parser [Strict.Text] tagsParser = char '@' >> namesParser -filterParser :: GenParser Char st ([String], [String], [String])+filterParser :: Parser ([Strict.Text], [Strict.Text], [Strict.Text],+                        [(Strict.Text, Strict.Text)]) filterParser =   do-    suites <- option [] (suitesParser)+    suites <- option [] suitesParser     path <- pathParser     tagselector <- option [] tagsParser-    return (suites, path, tagselector)+    options <- option [] optionsParser+    return (suites, path, tagselector, options) -makeFilter :: ([String], [String], [String]) -> Filter-makeFilter (suites, path, tags) =+makeFilter :: ([Strict.Text], [Strict.Text], [Strict.Text],+               [(Strict.Text, Strict.Text)]) -> Filter+makeFilter (suites, path, tags, options) =   let     withTags = case tags of       [] -> allSelector-      _ -> allSelector { selectorTags = Just $! Set.fromList tags }+      _ -> allSelector { selectorTags = Just $! HashSet.fromList tags }      genPath [] = withTags     genPath (elem : rest) =-      Selector { selectorInners = Map.singleton elem $! genPath rest,-                 selectorTags = Nothing }+      let+        innermap = HashMap.singleton elem $! genPath rest+      in+        Selector { selectorInners = innermap, selectorTags = Nothing }      withPath = genPath path   in-   Filter { filterSuites = Set.fromList suites, filterSelector = withPath }+   Filter { filterSuites = HashSet.fromList suites,+            filterSelector = HashSet.singleton withPath,+            filterOptions = HashMap.fromList options }  -- | Parse a 'Filter' expression.  The format for filter expressions is -- described in the module documentation. parseFilter :: String             -- ^ The name of the source.-            -> String+            -> Strict.Text             -- ^ The input.-            -> Either String Filter+            -> Either Strict.Text Filter parseFilter sourcename input =   case parse filterParser sourcename input of-    Left e -> Left (show e)+    Left e -> Left (Strict.pack (show e))     Right res -> Right (makeFilter res) -commentParser :: GenParser Char st ()+commentParser :: Parser () commentParser =   do     _ <- char '#'     _ <- many (noneOf "\n")-    return $ ()+    return () -lineParser :: GenParser Char st (Maybe Filter)+lineParser :: Parser (Maybe Filter) lineParser =   do     _ <- many space@@ -335,8 +474,8 @@     _ <- many space     optional commentParser     case content of-      ([], [], []) -> return $ Nothing-      _ -> return $ (Just (makeFilter content))+      ([], [], [], []) -> return Nothing+      _ -> return (Just $! makeFilter content)  -- | Parse content from a testlist file.  The file must contain one -- filter per line.  Leading and trailing spaces are ignored, as are@@ -344,37 +483,41 @@ -- the rest of the line. parseFilterFileContent :: String                        -- ^ The name of the input file.-                       -> String+                       -> Strict.Text                        -- ^ The file content.-                       -> Either [String] [Filter]+                       -> Either [Strict.Text] [Filter] parseFilterFileContent sourcename input =   let-    inputlines = lines input+    inputlines = Strict.lines input     results = map (parse lineParser sourcename) inputlines   in case partitionEithers results of-    ([], maybes) -> Right (catMaybes maybes)-    (errs, _) -> Left (map show errs)+    ([], maybes) -> Right $! catMaybes maybes+    (errs, _) -> Left $! map (Strict.pack . show) errs  -- | Given a 'FilePath', get the contents of the file and parse it as -- a testlist file.-parseFilterFile :: FilePath -> IO (Either [String] [Filter])+parseFilterFile :: FilePath -> IO (Either [Strict.Text] [Filter]) parseFilterFile filename =   do-    input <- try (readFile filename)+    input <- try (Strict.readFile filename)     case input of       Left e         | isAlreadyInUseError e ->-          return (Left ["Error reading testlist file " ++ filename ++-                        ": File is already in use"])+          return (Left [Strict.concat ["Error reading testlist file ",+                                       Strict.pack filename,+                                       ": File is already in use"]])         | isDoesNotExistError e ->-          return (Left ["Error reading testlist file " ++ filename ++-                        ": File does not exist"])+          return (Left [Strict.concat ["Error reading testlist file ",+                                       Strict.pack filename,+                                       ": File does not exist"]])         | isPermissionError e ->-          return (Left ["Error reading testlist file " ++ filename ++-                        ": Permission denied"])+          return (Left [Strict.concat ["Error reading testlist file ",+                                       Strict.pack filename,+                                       ": Permission denied"]])         | otherwise ->-          return (Left ["Cannot read testlist file " ++ filename ++-                        ": Miscellaneous error"])+          return (Left [Strict.concat ["Cannot read testlist file ",+                                       Strict.pack filename,+                                       ": Miscellaneous error"]])       Right contents ->         case parseFilterFileContent filename contents of           Left errs -> return (Left errs)

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}  -- | A mostly-complete test selection and execution program for -- running HUnit-Plus tests.  The only thing missing are the actual@@ -57,9 +57,8 @@        ) where  import Control.Exception-import Data.ByteString.Lazy(hPut) import Data.Either-import Data.Map(Map)+import Data.HashMap.Strict(HashMap) import System.Console.CmdArgs hiding (Quiet) import System.Exit import System.IO@@ -72,6 +71,10 @@ import Text.XML.Expat.Format import Text.XML.Expat.Tree(Node) +import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Text as Strict+import qualified Data.Text.IO as Strict+ -- | Console mode options. data ConsoleMode =   -- | Do not generate any console output.@@ -126,11 +129,11 @@     xmlreport = []       &= typFile       &= help "Output an XML report, with an optional filename for the report (default is \"report.xml\")"-      &= opt "report.xml",+      &= opt ("report.xml" :: String),     txtreport = []       &= typFile       &= help "Output a plain text report, with an optional filename for the report (default is \"report.txt\")"-      &= opt "report.txt",+      &= opt ("report.txt" :: String),     consmode = []       &= explicit       &= name "c"@@ -168,11 +171,11 @@ -- | Read and parse a single test list file parseTestLists :: Opts                -- ^ The command line options-               -> IO (Either [String] [Filter])+               -> IO (Either [Strict.Text] [Filter]) parseTestLists Opts { testlist = filenames, filters = cmdfilters } =   let     cmdresults = map (either (Left . (: [])) (Right . (: [])) .-                      parseFilter "command line") cmdfilters+                      parseFilter "command line") (map Strict.pack cmdfilters)   in do     fileresults <- mapM parseFilterFile filenames     case partitionEithers (fileresults ++ cmdresults) of@@ -180,12 +183,12 @@       (errs, _) -> return (Left (concat errs))  -- | Translate an @IOError@ into an error message-interpretException :: String+interpretException :: Strict.Text                    -- ^ Prefix to attach to error messages                    -> IOError                    -- ^ Exception to interpret-                   -> String-interpretException prefix e = prefix ++ show e+                   -> Strict.Text+interpretException prefix e = Strict.concat [prefix, Strict.pack (show e)]  -- | Get the file for reporting XML data withReportHandles :: Opts@@ -193,7 +196,7 @@                    -> (Maybe Handle -> Maybe Handle -> IO a)                    -- ^ A monad parameterized by the xml report handle                    -- and the text report handle.-                   -> IO (Either [String] a)+                   -> IO (Either [Strict.Text] a) withReportHandles Opts { xmlreport = [], txtreport = [] } cmd =   cmd Nothing Nothing >>= return . Right withReportHandles Opts { xmlreport = [ xmlfile ], txtreport = [] } cmd =@@ -271,7 +274,7 @@     case res of       Left errs ->         do-          mapM_ (putStr . (++ "\n")) errs+          mapM_ Strict.putStrLn errs           exitFailure       Right False -> exitFailure       Right True -> exitSuccess@@ -280,7 +283,7 @@ -- simply a wrapper around this function.  This function allows users -- to supply their own options, and to decide what to do with the -- result of test execution.-topLevel :: [TestSuite] -> Opts -> IO (Either [String] Bool)+topLevel :: [TestSuite] -> Opts -> IO (Either [Strict.Text] Bool) topLevel suites cmdopts @ Opts { consmode = cmodeopt } =   let     cmode = case cmodeopt of@@ -303,7 +306,7 @@  executeTests :: [TestSuite]              -- ^ The test suites to run-             -> Map String Selector+             -> HashMap Strict.Text (HashMap OptionMap Selector)              -- ^ The filters to use              -> ConsoleMode              -- ^ The mode to use for console output@@ -317,8 +320,8 @@     textTerminalReporter = textReporter (putTextToHandle stdout) False     verboseTerminalReporter = textReporter (putTextToHandle stdout) True -    writeXML :: Handle -> [[Node String String]] -> IO ()-    writeXML outhandle [[tree]] = hPut outhandle (format tree)+    writeXML :: Handle -> [[Node Strict.Text Strict.Text]] -> IO ()+    writeXML outhandle [[tree]] = ByteString.hPut outhandle (format tree)     writeXML _ _ =       error "Internal error in XML reporting: extra nodes on node stack" 

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Reporting functionality for HUnit-Plus.  Test reporting is now -- defined using a set of events.  A 'Reporter' contains handlers for@@ -23,10 +24,11 @@        combinedReporter        ) where -import Data.List-import Data.Map(Map)+import Data.HashMap.Strict(HashMap) import Distribution.TestSuite +import qualified Data.Text as Strict+ -- | A record that holds the results of tests that have been performed -- up until this point. data Counts =@@ -54,13 +56,13 @@ data State =   State {     -- | The name of the case or suite currently being run.-    stName :: !String,+    stName :: !Strict.Text,     -- | The path to the test case currently being run.     stPath :: !Path,     -- | The current test statistics.     stCounts :: !Counts,     -- | The current option values.-    stOptions :: !(Map String String),+    stOptions :: !(HashMap Strict.Text Strict.Text),     -- | The current option descriptions we know about.     stOptionDescs :: ![OptionDescr]   }@@ -71,7 +73,7 @@ type Path = [Node]  -- | Composed into 'Path's.-data Node = Label String+data Node = Label Strict.Text   deriving (Eq, Show, Read)  -- | Report generator.  This record type contains a number of@@ -108,7 +110,7 @@                       --  The user state for this test reporter                       -> IO us,     -- | Called to report progress of a test case run.-    reporterCaseProgress :: String+    reporterCaseProgress :: Strict.Text                          --  A progress message                          -> State                          --  The HUnit internal state@@ -130,7 +132,7 @@                      --  The user state for this test reporter                      -> IO us,     -- | Called to report output printed to the system output stream.-    reporterSystemOut :: String+    reporterSystemOut :: Strict.Text                       --  The content printed to system out                       -> State                       --  The HUnit internal state@@ -138,7 +140,7 @@                       --  The user state for this test reporter                       -> IO us,     -- | Called to report output printed to the system error stream.-    reporterSystemErr :: String+    reporterSystemErr :: Strict.Text                       --  The content printed to system out                       -> State                       --  The HUnit internal state@@ -146,7 +148,7 @@                       --  The user state for this test reporter                       -> IO us,     -- | Called when a test fails.-    reporterFailure :: String+    reporterFailure :: Strict.Text                     --  A message relating to the error                     -> State                     --  The HUnit internal state@@ -154,7 +156,7 @@                     --  The user state for this test reporter                     -> IO us,     -- | Called when a test reports an error.-    reporterError :: String+    reporterError :: Strict.Text                   --  A message relating to the error                   -> State                   --  The HUnit internal state@@ -189,27 +191,34 @@ -- | Converts a test case path to a string, separating adjacent elements by --   a dot (\'.\'). An element of the path is quoted (as with 'show') when --   there is potential ambiguity.-showPath :: Path -> String+showPath :: Path -> Strict.Text showPath [] = "" showPath nodes =   let-    showNode (Label label) = safe label (show label)-    safe s ss = if '.' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s+    showNode (Label label) = safe label label+    safe s ss =+      if Strict.any ('.' ==) s || Strict.concat ["\"", s, "\""] /= ss+        then ss+        else s   in-    intercalate "." (reverse (map showNode nodes))+    Strict.intercalate "." (reverse (map showNode nodes))  -- | Gewerate a string showing the entire qualified name from the -- reporting state.-showQualName :: State -> String+showQualName :: State -> Strict.Text showQualName st =   case stPath st of     [] -> stName st     nodes ->       let-        showNode (Label label) = safe label (show label)-        safe s ss = if '.' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s+        showNode (Label label) = safe label label+        safe s ss =+          if Strict.any ('.' ==) s || Strict.concat ["\"", s, "\""] /= ss+            then ss+            else s       in-        intercalate "." (reverse (map showNode nodes)) ++ "." ++ stName st+        Strict.concat [Strict.intercalate "." (reverse (map showNode nodes)),+                       ".", stName st]   -- | Combines two 'Reporter's into a single reporter that calls both.@@ -245,73 +254,73 @@       do         us1 <- reportStart1         us2 <- reportStart2-        return $! (us1, us2)+        return (us1, us2)      reportEnd time counts (us1, us2) =       do         us1' <- reportEnd1 time counts us1         us2' <- reportEnd2 time counts us2-        return $! (us1', us2')+        return (us1', us2')      reportStartSuite ss (us1, us2) =       do         us1' <- reportStartSuite1 ss us1         us2' <- reportStartSuite2 ss us2-        return $! (us1', us2')+        return (us1', us2')      reportEndSuite time ss (us1, us2) =       do         us1' <- reportEndSuite1 time ss us1         us2' <- reportEndSuite2 time ss us2-        return $! (us1', us2')+        return (us1', us2')      reportStartCase ss (us1, us2) =       do         us1' <- reportStartCase1 ss us1         us2' <- reportStartCase2 ss us2-        return $! (us1', us2')+        return (us1', us2')      reportCaseProgress msg ss (us1, us2) =       do         us1' <- reportCaseProgress1 msg ss us1         us2' <- reportCaseProgress2 msg ss us2-        return $! (us1', us2')+        return (us1', us2')      reportEndCase time ss (us1, us2) =       do         us1' <- reportEndCase1 time ss us1         us2' <- reportEndCase2 time ss us2-        return $! (us1', us2')+        return (us1', us2')      reportSkipCase ss (us1, us2) =       do         us1' <- reportSkipCase1 ss us1         us2' <- reportSkipCase2 ss us2-        return $! (us1', us2')+        return (us1', us2')      reportSystemOut msg ss (us1, us2) =       do         us1' <- reportSystemOut1 msg ss us1         us2' <- reportSystemOut2 msg ss us2-        return $! (us1', us2')+        return (us1', us2')      reportSystemErr msg ss (us1, us2) =       do         us1' <- reportSystemErr1 msg ss us1         us2' <- reportSystemErr2 msg ss us2-        return $! (us1', us2')+        return (us1', us2')      reportFailure msg ss (us1, us2) =       do         us1' <- reportFailure1 msg ss us1         us2' <- reportFailure2 msg ss us2-        return $! (us1', us2')+        return (us1', us2')      reportError msg ss (us1, us2) =       do         us1' <- reportError1 msg ss us1         us2' <- reportError2 msg ss us2-        return $! (us1', us2')+        return (us1', us2')   in     Reporter {       reporterStart = reportStart,

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Text-based reporting functionality for reporting either as text, -- or to the terminal.  This module is an adaptation of code from the@@ -32,11 +33,12 @@ import Test.HUnitPlus.Reporting  import Control.Monad (when)-import System.IO (Handle, stderr, hPutStr, hPutStrLn)+import System.IO (Handle, stderr) import Text.Printf(printf) -import qualified Data.Map as Map-+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict+import qualified Data.Text.IO as Strict  -- | The text-based reporters ('textReporter' and 'terminalReporter') -- construct strings and pass them to the function embodied in a@@ -44,24 +46,24 @@ -- ways.  Two schemes are defined here.  'putTextToHandle' writes -- report lines to a given handle.  'putTextToShowS' accumulates lines -- for return as a whole.--- +-- -- The 'PutText' function is also passed, and returns, an arbitrary state -- value (called 'st' here).  The initial state value is given in the -- 'PutText'; the final value is returned by 'runTestText'. -data PutText st = PutText (String -> st -> IO st) st+data PutText st = PutText (Strict.Text -> st -> IO st) st  -- | Writes persistent lines to the given handle. putTextToHandle :: Handle -> PutText ()-putTextToHandle handle = PutText (\line () -> hPutStr handle line) ()+putTextToHandle handle = PutText (\line () -> Strict.hPutStr handle line) ()  -- | Accumulates lines for return by 'runTestText'.  The -- accumulated lines are represented by a @'ShowS' ('String' -> -- 'String')@ function whose first argument is the string to be -- appended to the accumulated report lines.-putTextToShowS :: PutText ShowS+putTextToShowS :: PutText (Strict.Text -> Strict.Text) putTextToShowS =-  PutText (\line func -> return (\rest -> func (line ++ rest))) id+  PutText (\line func -> return (\rest -> func (Strict.concat [line, rest]))) id  -- | Create a 'Reporter' that outputs a textual report for -- non-terminal output.@@ -75,36 +77,36 @@     reportProblem prefix msg ss us =       let         path = showQualName ss-        line = "### " ++ prefix ++ path ++ ": " ++ msg ++ "\n"+        line = Strict.concat ["### ", prefix, path, ": ", msg, "\n"]       in         put line us      reportOutput prefix msg ss us =       let         path = showQualName ss-        line = "### " ++ prefix ++ path ++ ": " ++ msg ++ "\n"+        line = Strict.concat ["### ", prefix, path, ": ", msg, "\n"]       in         if verbose then put line us else return us      reportStartSuite ss us =       let-        line = "Test suite " ++ stName ss ++ " starting\n"+        line = Strict.concat ["Test suite ", stName ss, " starting\n"]       in         if verbose then put line us else return us      reportEndSuite time ss us =       let         timestr = printf "%.6f" time-        line = "Test suite" ++ stName ss ++ " completed in " ++-               timestr ++ " sec\n"+        line = Strict.concat ["Test suite", stName ss, " completed in ",+                              Strict.pack timestr, " sec\n"]       in         if verbose then put line us else return us      reportStartCase ss us =       let         path = showQualName ss-        line = if null path then "Test case starting\n"-               else "Test case " ++ path ++ " starting\n"+        line = if Strict.null path then "Test case starting\n"+               else Strict.concat ["Test case ", path, " starting\n"]       in         if verbose then put line us else return us @@ -112,23 +114,26 @@       let         path = showQualName ss         timestr = printf "%.6f" time-        line = if null path then "Test completed in " ++ timestr ++ " sec\n"-               else "Test " ++ path ++ " completed in " ++ timestr ++ " sec\n"+        line = if Strict.null path+                 then Strict.concat ["Test completed in ",+                                     Strict.pack timestr, " sec\n"]+                 else Strict.concat ["Test ", path, " completed in ",+                                     Strict.pack timestr, " sec\n"]       in         if verbose then put line us else return us      reportEnd time counts us =       let-        countstr = showCounts counts ++ "\n"+        countstr = Strict.concat [showCounts counts, "\n"]         timestr = printf "%.6f" time-        timeline = "Tests completed in " ++ timestr ++ " sec\n"+        timeline = Strict.concat ["Tests completed in ",+                                  Strict.pack timestr, " sec\n"]       in do         if verbose           then do             us' <- put timeline us             put countstr us'-          else-            put countstr us+          else put countstr us   in     defaultReporter {       reporterStart = return initUs,@@ -161,13 +166,13 @@ runTestText puttext @ (PutText put us0) verbose t =   let     initState = State { stCounts = zeroCounts, stName = "",-                        stPath = [], stOptions = Map.empty,+                        stPath = [], stOptions = HashMap.empty,                         stOptionDescs = [] }      reporter = textReporter puttext verbose   in do     (ss1, us1) <- ((performTest $! reporter) allSelector $! initState) us0 t-    us2 <- put (showCounts (stCounts ss1) ++ "\n") us1+    us2 <- put (Strict.concat [showCounts (stCounts ss1), "\n"]) us1     return (stCounts ss1, us2)  -- | Execute a test suite, processing text output according to the@@ -188,11 +193,12 @@ runSuiteText puttext @ (PutText put us0) verbose              suite @ TestSuite { suiteName = sname } =   let-    selectorMap = Map.singleton sname allSelector+    selectorMap = HashMap.singleton sname (HashMap.singleton HashMap.empty+                                                             allSelector)     reporter = textReporter puttext verbose   in do     (counts, us1) <- ((performTestSuite $! reporter) $!selectorMap) us0 suite-    us2 <- put (showCounts counts ++ "\n") us1+    us2 <- put (Strict.concat [showCounts counts, "\n"]) us1     return (counts, us2)  -- | Execute the given test suites, processing text output according@@ -213,35 +219,50 @@ runSuitesText puttext @ (PutText put _) verbose suites =   let     suiteNames = map suiteName suites-    selectorMap = foldl (\suitemap sname ->-                          Map.insert sname allSelector suitemap)-                        Map.empty suiteNames+    selectorMap =+      foldl (\suitemap sname ->+              HashMap.insert sname (HashMap.singleton HashMap.empty+                                                      allSelector) suitemap)+            HashMap.empty suiteNames     reporter = textReporter puttext verbose   in do     (counts, us1) <- ((performTestSuites $! reporter) $! selectorMap) suites-    us2 <- put (showCounts counts ++ "\n") us1+    us2 <- put (Strict.concat [showCounts counts, "\n"]) us1     return (counts, us2)  -- | Converts test execution counts to a string.-showCounts :: Counts -> String+showCounts :: Counts -> Strict.Text showCounts Counts { cCases = cases, cTried = tried,                     cErrors = errors, cFailures = failures,                     cAsserts = asserts, cSkipped = skipped } =-  "Cases: " ++ show cases ++ "  Tried: " ++ show tried ++-  "  Errors: " ++ show errors ++ "  Failures: " ++ show failures ++-  "  Assertions: " ++ show asserts ++ "  Skipped: " ++ show skipped+  Strict.concat ["Cases: ", Strict.pack (show cases), "  Tried: ",+                 Strict.pack (show tried), "  Errors: ",+                 Strict.pack (show errors), "  Failures: ",+                 Strict.pack (show failures), "  Assertions: ",+                 Strict.pack (show asserts), "  Skipped: ",+                 Strict.pack (show skipped)]  -- | Terminal output function, used by the run*TT function and -- terminal reporters.-termPut :: String -> Bool -> Int -> IO Int-termPut line pers (-1) = do when pers (hPutStrLn stderr line); return (-1)-termPut line True  cnt = do hPutStrLn stderr (erase cnt ++ line); return 0-termPut line False _   = do hPutStr stderr ('\r' : line); return (length line)+termPut :: Strict.Text -> Bool -> Int -> IO Int+termPut line pers (-1) =+  do+    when pers (Strict.hPutStrLn stderr line)+    return (-1)+termPut line True cnt =+  do+    Strict.hPutStrLn stderr (Strict.concat [erase cnt, line])+    return 0+termPut line False _ =+  do+    Strict.hPutStr stderr (Strict.concat ["\r", line])+    return (Strict.length line)  -- The "erasing" strategy with a single '\r' relies on the fact that the -- lengths of successive summary lines are monotonically nondecreasing.-erase :: Int -> String-erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"+erase :: Int -> Strict.Text+erase cnt =+  if cnt == 0 then "" else Strict.concat ["\r", Strict.replicate cnt " ", "\r"]  -- | A reporter that outputs lines indicating progress to the -- terminal.  Reporting is made to standard error, and progress@@ -251,16 +272,15 @@   let     reportProblem prefix msg ss us =       let-        line = "### " ++ prefix ++ path ++ '\n' : msg+        line = Strict.concat ["### ", prefix, path, "\n", msg]         path = showQualName ss       in         termPut line True us   in     defaultReporter {       reporterStart = return 0,-      reporterEnd = (\_ _ _ -> do hPutStr stderr "\n"; return 0),-      reporterEndCase =-        (\_ ss us -> termPut (showCounts (stCounts ss)) False us),+      reporterEnd = \_ _ _ -> do Strict.hPutStr stderr "\n"; return 0,+      reporterEndCase = \_ ss us -> termPut (showCounts (stCounts ss)) False us,       reporterError = reportProblem "Error in:   ",       reporterFailure = reportProblem "Failure in: "     }@@ -277,7 +297,7 @@ runTestTT t =   let     initState = State { stCounts = zeroCounts, stName = "",-                        stPath = [], stOptions = Map.empty,+                        stPath = [], stOptions = HashMap.empty,                         stOptionDescs = [] }   in do     (ss1, us1) <- (performTest terminalReporter allSelector $! initState) 0 t@@ -295,10 +315,11 @@ runSuiteTT :: TestSuite -> IO Counts runSuiteTT suite @ TestSuite { suiteName = sname } =   let-    selectorMap = Map.singleton sname allSelector+    selectorMap = HashMap.singleton sname (HashMap.singleton HashMap.empty+                                                             allSelector)   in do     (counts, us) <- (performTestSuite terminalReporter $! selectorMap) 0 suite-    0 <- termPut (showCounts counts ++ "\n") True us+    0 <- termPut (Strict.concat [showCounts counts, "\n"]) True us     return counts  -- | Execute the given test suites, processing text output according@@ -313,10 +334,12 @@ runSuitesTT suites =   let     suiteNames = map suiteName suites-    selectorMap = foldl (\suitemap sname ->-                          Map.insert sname allSelector suitemap)-                        Map.empty suiteNames+    selectorMap =+      foldl (\suitemap sname ->+              HashMap.insert sname (HashMap.singleton HashMap.empty+                                                      allSelector) suitemap)+            HashMap.empty suiteNames   in do     (counts, us) <- (performTestSuites terminalReporter $! selectorMap) suites-    0 <- termPut (showCounts counts ++ "\n") True us+    0 <- termPut (Strict.concat [showCounts counts, "\n"]) True us     return counts

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall -Werror -funbox-strict-fields #-}+{-# LANGUAGE OverloadedStrings #-}  -- | 'Reporter' for running HUnit tests and reporting results as -- JUnit-style XML reports.  This uses the hexpat library for XML@@ -20,84 +21,86 @@        xmlReporter        ) where -import Data.Map(Map)+import Data.HashMap.Strict(HashMap)+import Data.List(sort) import Data.Time import Network.HostName import Test.HUnitPlus.Reporting(Reporter(..), State(..), Counts(..),                                 defaultReporter, showPath) import Text.XML.Expat.Tree -import qualified Data.Map as Map+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict  -- | Generate an element for a property definition-propertyElem :: (String, String)+propertyElem :: (Strict.Text, Strict.Text)              -- ^ The name/value pair-             -> Node String String+             -> Node Strict.Text Strict.Text propertyElem (name, value) = Element { eName = "property", eChildren = [],                                        eAttributes = [("name", name),                                                       ("value", value)] }  -- | Generate an element for a set of property definitions-propertiesElem :: [(String, String)]+propertiesElem :: [(Strict.Text, Strict.Text)]                -- ^ A list of name/value pairs to make into properties-               -> Node String String+               -> Node Strict.Text Strict.Text propertiesElem props = Element { eName = "properties", eAttributes = [],                                  eChildren = map propertyElem props }  -- | Generate an element representing output to stdout-systemOutElem :: String+systemOutElem :: Strict.Text               -- ^ The stdout output-              -> Node String String+              -> Node Strict.Text Strict.Text systemOutElem content = Element { eName = "system-out", eAttributes = [],                                   eChildren = [Text content] }  -- | Generate an element representing output to stderr-systemErrElem :: String+systemErrElem :: Strict.Text               -- ^ The stderr output-              -> Node String String+              -> Node Strict.Text Strict.Text systemErrElem content = Element { eName = "system-err", eAttributes = [],                                   eChildren = [Text content] }  -- | Generate an element representing a test failure.-failureElem :: String+failureElem :: Strict.Text             -- ^ A message associated with the failure-            -> Node String String+            -> Node Strict.Text Strict.Text failureElem message = Element { eAttributes = [("message", message)],                                 eName = "failure", eChildren = [] }  -- | Generate an element representing an error in a test.-errorElem :: String+errorElem :: Strict.Text           -- ^ A message associated with the error-          -> Node String String+          -> Node Strict.Text Strict.Text errorElem message = Element { eAttributes = [("message", message)],                               eName = "error", eChildren = [] }  -- | Generate an element for a single test case.-testcaseElem :: String+testcaseElem :: Strict.Text              -- ^ The name of the test-             -> String+             -> Strict.Text              -- ^ The path to the test (reported as \"classname\")              -> Word              -- ^ The number of assertions in the test              -> Double              -- ^ The execution time of the test-             -> [Node String String]+             -> [Node Strict.Text Strict.Text]              -- ^ Elements representing the events that happened              -- during test execution.-             -> Node String String+             -> Node Strict.Text Strict.Text testcaseElem name classname assertions time children =   Element { eName = "testcase", eChildren = children,             eAttributes = [("name", name),                            ("classname", classname),-                           ("assertions", show assertions),-                           ("time", show time)] }+                           ("assertions", Strict.pack (show assertions)),+                           ("time", Strict.pack (show time))] }  -- | Generate an element for a skipped test case-skippedTestElem :: String+skippedTestElem :: Strict.Text                 -- ^ The name of the test-                -> String+                -> Strict.Text                 -- ^ The path of the test-                -> Node String String+                -> Node Strict.Text Strict.Text skippedTestElem name classname =   let     skippedElem = Element { eName = "skipped", eAttributes = [],@@ -107,9 +110,9 @@               eName = "testcase", eChildren = [skippedElem] }  -- | Generate an element for a test suite run-testSuiteElem :: String+testSuiteElem :: Strict.Text               -- ^ The name of the test suite-              -> Map String String+              -> HashMap Strict.Text Strict.Text               -- ^ The properties defined for this suite               -> Word               -- ^ The number of tests@@ -119,20 +122,20 @@               -- ^ The number of errors               -> Word               -- ^ The number of skipped tests-              -> String+              -> Strict.Text               -- ^ The hostname of the machine on which this was run               -> UTCTime               -- ^ The timestamp at which time this was run               -> Double               -- ^ The execution time for the test suite-              -> [Node String String]+              -> [Node Strict.Text Strict.Text]               -- ^ The testcases and output nodes for the test suite-              -> Node String String+              -> Node Strict.Text Strict.Text testSuiteElem name propmap tests failures errors skipped               hostname timestamp time content =   let     contentWithProps =-      case Map.assocs propmap of+      case sort (HashMap.toList propmap) of         [] -> content         props -> propertiesElem props : content     timestr = formatTime defaultTimeLocale "%c" timestamp@@ -140,25 +143,25 @@     Element { eName = "testsuite", eChildren = contentWithProps,               eAttributes = [("name", name),                              ("hostname", hostname),-                             ("timestamp", timestr),-                             ("time", show time),-                             ("tests", show tests),-                             ("failures", show failures),-                             ("errors", show errors),-                             ("skipped", show skipped)] }+                             ("timestamp", Strict.pack timestr),+                             ("time", Strict.pack (show time)),+                             ("tests", Strict.pack (show tests)),+                             ("failures", Strict.pack (show failures)),+                             ("errors", Strict.pack (show errors)),+                             ("skipped", Strict.pack (show skipped))] }  -- | Generate the top-level element containing all test suites testSuitesElem :: Double                -- ^ The execution time of all suites-               -> [Node String String]+               -> [Node Strict.Text Strict.Text]                -- ^ Elements representing all the test suites-               -> Node String String+               -> Node Strict.Text Strict.Text testSuitesElem time suites =   Element { eName = "testsuites", eChildren = suites,-            eAttributes = [("time", show time)] }+            eAttributes = [("time", Strict.pack (show time))] }  -- | A reporter that generates JUnit XML reports-xmlReporter :: Reporter [[Node String String]]+xmlReporter :: Reporter [[Node Strict.Text Strict.Text]] xmlReporter =   let     reportStart = return [[]]@@ -178,8 +181,8 @@         hostname <- getHostName         timestamp <- getCurrentTime         return ((testSuiteElem name options cases failures errors skipped-                               hostname timestamp time (reverse events) :-                 rest) : stack)+                               (Strict.pack hostname) timestamp time+                               (reverse events) : rest) : stack)     reportEndSuite _ _ stack =       fail ("Node stack underflow in end suite.\n" ++ show stack) 

@@ -0,0 +1,7 @@+module Tests where++import Distribution.TestSuite+import qualified Tests.Test as Test++tests :: IO [Test]+tests = return [Test.tests]

@@ -0,0 +1,7 @@+module Tests.Test where++import Distribution.TestSuite+import qualified Tests.Test.HUnitPlus as HUnitPlus++tests :: Test+tests = testGroup "Test" [HUnitPlus.tests]

@@ -0,0 +1,15 @@+module Tests.Test.HUnitPlus where++import Distribution.TestSuite+import qualified Tests.Test.HUnitPlus.Base as Base+import qualified Tests.Test.HUnitPlus.Execution as Execution+import qualified Tests.Test.HUnitPlus.Filter as Filter+import qualified Tests.Test.HUnitPlus.Main as Main+import qualified Tests.Test.HUnitPlus.Reporting as Reporting+import qualified Tests.Test.HUnitPlus.Text as Text+import qualified Tests.Test.HUnitPlus.XML as XML++tests :: Test+tests = testGroup "HUnitPlus" [Base.tests, Execution.tests, Filter.tests,+                               Reporting.tests, Main.tests,+                               Text.tests, XML.tests]

@@ -0,0 +1,588 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}++module Tests.Test.HUnitPlus.Base(tests) where++import Control.Exception(Exception,+                         throwIO)+import Data.List+import Data.Typeable+import Debug.Trace+import Distribution.TestSuite(Test(..),+                              TestInstance(..),+                              Result(..),+                              Progress(..),+                              testGroup)+import Test.HUnitPlus.Base+import Test.HUnitPlus.Reporting++import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet+import qualified Tests.Test.HUnitPlus.ReporterUtils as Utils++type ReportEvent = Utils.ReportEvent++loggingReporter = Utils.loggingReporter++makeTestCase :: (Test, String, [String], Counts, [ReportEvent]) -> Test+makeTestCase (Test TestInstance { name = actualName,+                                  tags = actualTags,+                                  run = runInnerTest },+              expectedName, expectedTags, expectedCounts, expectedEvents) =+  let+    initState = State { stCounts = zeroCounts, stName = "", stPath = [],+                        stOptions = HashMap.empty, stOptionDescs = [] }++    genResult actualCounts actualEvents =+      let+        nameErr =+          if actualName /= expectedName+            then ["Expected name \"" ++ expectedName +++                  "\" but got \"" ++ actualName ++ "\""]+            else []+        tagsErr =+          if HashSet.fromList expectedTags /= HashSet.fromList actualTags+            then ("Expected tags " ++ show expectedTags +++                  " but got " ++ show actualTags) : nameErr+            else nameErr+        countsErr =+          if expectedCounts /= actualCounts+            then ("Expected counts " ++ show expectedCounts +++                  " but got " ++ show actualCounts) : tagsErr+            else tagsErr+        eventsErr =+          if expectedEvents /= actualEvents+            then ("Expected reporting events " ++ show expectedEvents +++                  " but got " ++ show actualEvents) : countsErr+            else countsErr+      in case eventsErr of+        [] -> Finished Pass+        _ -> Finished (Fail (intercalate "\n" eventsErr))++    runRealTest =+      do+        (_, State { stCounts = actualCounts }, actualEvents) <-+          executeTest loggingReporter initState [] runInnerTest+        return (genResult actualCounts actualEvents)++    testInstance = TestInstance { name = actualName, tags = [], options = [],+                                  setOption = (\_ _ -> Right testInstance),+                                  run = runRealTest }+  in+    Test testInstance++oneFail :: Counts+oneFail = zeroCounts { cFailures = 1 }++oneError :: Counts+oneError = zeroCounts { cErrors = 1 }++oneAssert :: Counts+oneAssert = zeroCounts { cAsserts = 1, cCaseAsserts = 1 }++twoFails :: Counts+twoFails = zeroCounts { cFailures = 2 }++twoErrors :: Counts+twoErrors = zeroCounts { cErrors = 2 }++twoAsserts :: Counts+twoAsserts = zeroCounts { cAsserts = 2, cCaseAsserts = 2 }++oneFailOneAssert :: Counts+oneFailOneAssert = zeroCounts { cFailures = 1, cAsserts = 1, cCaseAsserts = 1 }++twoFailsOneAssert :: Counts+twoFailsOneAssert = zeroCounts { cFailures = 2, cAsserts = 1, cCaseAsserts = 1 }++oneFailOneAssertOneError :: Counts+oneFailOneAssertOneError =+  zeroCounts { cFailures = 1, cErrors = 1, cAsserts = 1, cCaseAsserts = 1 }++oneErrorOneAssert :: Counts+oneErrorOneAssert = zeroCounts { cErrors = 1, cAsserts = 1, cCaseAsserts = 1 }++oneFailTwoAsserts :: Counts+oneFailTwoAsserts = zeroCounts { cFailures = 1, cAsserts = 2, cCaseAsserts = 2 }++twoFailsTwoAsserts :: Counts+twoFailsTwoAsserts = zeroCounts { cFailures = 2, cAsserts = 2, cCaseAsserts = 2 }++twoErrorsTwoAsserts :: Counts+twoErrorsTwoAsserts = zeroCounts { cErrors = 2, cAsserts = 2, cCaseAsserts = 2 }++externalTestPass :: Test+externalTestPass =+  let+    runTest = return (Finished Pass)++    testInstance =  TestInstance { name = "externalTestPass", tags = [],+                                   options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++externalTestEventuallyPass :: Test+externalTestEventuallyPass =+  let+    runTest = return (eventually Pass)++    testInstance =  TestInstance { name = "externalTestEventuallyPass",+                                   tags = [], options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++externalTestFail :: Test+externalTestFail =+  let+    runTest = return (Finished (Fail "External Test Failed"))++    testInstance =  TestInstance { name = "externalTestFail", tags = [],+                                   options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++externalTestEventuallyFail :: Test+externalTestEventuallyFail =+  let+    runTest = return (eventually (Fail "External Test Failed"))++    testInstance =  TestInstance { name = "externalTestEventuallyFail",+                                   tags = [], options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++externalTestError :: Test+externalTestError =+  let+    runTest = return (Finished (Error "External Test Error"))++    testInstance =  TestInstance { name = "externalTestError", tags = [],+                                   options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++externalTestEventuallyError :: Test+externalTestEventuallyError =+  let+    runTest = return (eventually (Error "External Test Error"))++    testInstance =  TestInstance { name = "externalTestEventuallyError",+                                   tags = [], options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++eventually :: Result -> Progress+eventually result =+  Progress "."+           (return (Progress ".."+                             (return (Progress "..."+                                               (return (Finished result))))))++externalTestException :: Test+externalTestException =+  let+    runTest = error "Exception Message" >> return (Finished Pass)++    testInstance =  TestInstance { name = "externalTestException",+                                   tags = [], options = [], run = runTest,+                                   setOption = (\_ _ -> return testInstance) }+  in+    Test testInstance++data TestException = TestException Bool+  deriving (Typeable, Show, Eq)++instance Exception TestException++testCases :: [(Test, String, [String], Counts, [ReportEvent])]+testCases = [+    -- Test low-level functions+    ("logAssert" ~: logAssert, "logAssert", [], oneAssert, []),+    ("logFailure" ~: logFailure "Fail Message", "logFailure", [],+     oneFail, [Utils.Failure "Fail Message"]),+    ("logError" ~: logError "Error Message", "logError", [],+     oneError, [Utils.Error "Error Message"]),+    ("logSysout" ~: logSysout "Sysout Message", "logSysout", [],+     zeroCounts, [Utils.SystemOut "Sysout Message"]),+    ("logSyserr" ~: logSyserr "Syserr Message", "logSyserr", [],+     zeroCounts, [Utils.SystemErr "Syserr Message"]),+    ("logAssert_twice" ~: do logAssert; logAssert,+     "logAssert_twice", [], twoAsserts, []),+    ("logFailure_twice" ~: do logFailure "Fail Message\n"+                              logFailure "Fail Message 2\n",+     "logFailure_twice", [], oneFail,+     [Utils.Failure "Fail Message\n", Utils.Failure "Fail Message 2\n"]),+    ("logError_twice" ~: do logError "Error Message\n"+                            logError "Error Message 2\n",+     "logError_twice", [], oneError,+     [Utils.Error "Error Message\n", Utils.Error "Error Message 2\n"]),+    -- Test assertion functions+    ("assertSuccess" ~: assertSuccess, "assertSuccess", [], oneAssert, []),+    ("assertSuccess_twice" ~: do assertSuccess; assertSuccess,+     "assertSuccess_twice", [], twoAsserts, []),+    ("assertFailure" ~: assertFailure "Fail Message", "assertFailure",+     [], oneFailOneAssert, [Utils.Failure "Fail Message"]),+    ("assertFailure_twice" ~: do assertFailure "Fail Message\n"+                                 assertFailure "Fail Message 2\n",+     "assertFailure_twice", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message\n", Utils.Failure "Fail Message 2\n"]),+    ("assertSuccess_assertFailure" ~: do assertSuccess+                                         assertFailure "Fail Message",+     "assertSuccess_assertFailure", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("assertFailure_assertSuccess" ~: do assertFailure "Fail Message"+                                         assertSuccess,+     "assertFailure_assertSuccess", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("abortError" ~: abortError "Error Message", "abortError", [], oneError,+     [Utils.Error "Error Message"]),+    ("abortFailure" ~: abortFailure "Failure Message", "abortFailure",+     [], oneFail, [Utils.Failure "Failure Message"]),+    ("assertFailure_abortError" ~: do assertFailure "Failure Message"+                                      abortError "Error Message",+     "assertFailure_abortError", [], oneFailOneAssertOneError,+     [Utils.Failure "Failure Message", Utils.Error "Error Message"]),+    ("assertFailure_abortFailure" ~: do assertFailure "Failure Message"+                                        abortFailure "Failure Message 2",+     "assertFailure_abortFailure", [], oneFailOneAssert,+     [Utils.Failure "Failure Message", Utils.Failure "Failure Message 2"]),+    ("abortError_assertFailure" ~: do abortError "Error Message"+                                      assertFailure "Failure Message",+     "abortError_assertFailure", [], oneError, [Utils.Error "Error Message"]),+    ("abortFailure_assertFailure" ~: do abortFailure "Failure Message"+                                        assertFailure "Failure Message 2",+     "abortFailure_assertFailure", [], oneFail,+     [Utils.Failure "Failure Message"]),+    ("assertBool_True" ~: assertBool "Fail Message" True,+     "assertBool_True", [], oneAssert, []),+    ("assertBool_False" ~: assertBool "Fail Message" False, "assertBool_False",+     [], oneFailOneAssert, [Utils.Failure "Fail Message"]),+    ("assertString_empty" ~: assertString "",+     "assertString_empty", [], oneAssert, []),+    ("assertString_nonempty" ~: assertString "non-empty",+     "assertString_nonempty", [], oneFailOneAssert, [Utils.Failure "non-empty"]),+    ("assertEqual_eq" ~: assertEqual "Prefix" 3 3,+     "assertEqual_eq", [], oneAssert, []),+    ("assertEqual_neq" ~: assertEqual "Prefix" 3 4,+     "assertEqual_neq", [], oneFailOneAssert,+     [Utils.Failure "Prefix\nexpected: 3\nbut got: 4"]),+    ("assertThrows_nothrow" ~: assertThrows (\(TestException _) -> assertSuccess)+                                            (return ()),+     "assertThrows_nothrow", [], oneFailOneAssert,+     [Utils.Failure "expected exception but computation finished normally"]),+    ("assertThrows_badthrow" ~: assertThrows (TestException False @=?)+                                             (throwIO (TestException True)),+     "assertThrows_badthrow", [], oneFailOneAssert,+     [Utils.Failure "expected: TestException False\nbut got: TestException True"]),+    ("assertThrows_goodthrow" ~: assertThrows (TestException True @=?)+                                              (throwIO (TestException True)),+     "assertThrows_goodthrow", [], oneAssert, []),+    ("assertThrowsExact_nothrow" ~: assertThrowsExact (TestException True)+                                                      (return ()),+     "assertThrowsExact_nothrow", [], oneFailOneAssert,+     [Utils.Failure ("expected exception TestException True but computation finished normally")]),+    ("assertThrowsExact_badthrow" ~:+       assertThrowsExact (TestException False) (throwIO (TestException True)),+     "assertThrowsExact_badthrow", [], oneFailOneAssert,+     [Utils.Failure ("expected exception TestException False but got TestException True")]),+    ("assertThrowsExact_goodthrow" ~:+       assertThrowsExact (TestException True) (throwIO (TestException True)),+     "assertThrowsExact_goodthrow", [], oneAssert, []),+    -- Assertable instances+    ("assert_Unit" ~: assert (), "assert_Unit", [], zeroCounts, []),+    ("assert_True" ~: assert True, "assert_True", [], oneAssert, []),+    ("assert_False" ~: assert False, "assert_False",+     [], oneFailOneAssert, [Utils.Failure ""]),+    ("assertWithMsg_True" ~: assertWithMsg "Message" True,+     "assertWithMsg_True", [], oneAssert, []),+    ("assertWithMsg_False" ~: assertWithMsg "Message" False,+     "assertWithMsg_False", [], oneFailOneAssert, [Utils.Failure "Message"]),+    ("assert_String_empty" ~: assert ("" :: String),+     "assert_String_empty", [], oneAssert, []),+    ("assert_String_nonempty" ~: assert ("non-empty" :: String), "assert_String_nonempty",+     [], oneFailOneAssert, [Utils.Failure "non-empty"]),+    ("assertWithMsg_String_empty" ~: assertWithMsg "Prefix: " ("" :: String),+     "assertWithMsg_String_empty", [], oneAssert, []),+    ("assertWithMsg_String_nonempty" ~: assertWithMsg "Prefix: " ("non-empty" :: String),+     "assertWithMsg_String_nonempty", [], oneFailOneAssert,+     [Utils.Failure "Prefix: non-empty"]),+    ("assert_list_assertSuccess_twice" ~: assert [assertSuccess, assertSuccess],+     "assert_list_assertSuccess_twice", [], twoAsserts, []),+    ("assert_list_assertFailure_twice" ~:+       assert [assertFailure "Fail Message\n", assertFailure "Fail Message 2\n"],+     "assert_list_assertFailure_twice", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message\n", Utils.Failure "Fail Message 2\n"]),+    ("assert_list_assertSuccess_assertFailure" ~:+       assert [assertSuccess, assertFailure "Fail Message"],+     "assert_list_assertSuccess_assertFailure", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("assert_list_assertFailure_assertSuccess" ~:+       assert [assertFailure "Fail Message", assertSuccess],+     "assert_list_assertFailure_assertSuccess", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("assertWithMsg_list_assertSuccess_twice" ~:+       assertWithMsg "Prefix: " [assertSuccess, assertSuccess],+     "assertWithMsg_list_assertSuccess_twice", [], twoAsserts, []),+    ("assertWithMsg_list_assertFailure_twice" ~:+       assertWithMsg "Prefix: " [assertFailure "Fail Message\n",+                                 assertFailure "Fail Message 2\n"],+     "assertWithMsg_list_assertFailure_twice", [], oneFailTwoAsserts,+     [Utils.Failure "Prefix: Fail Message\n",+      Utils.Failure "Prefix: Fail Message 2\n"]),+    ("assertWithMsg_list_assertSuccess_assertFailure" ~:+       assertWithMsg "Prefix: " [assertSuccess, assertFailure "Fail Message"],+     "assertWithMsg_list_assertSuccess_assertFailure", [], oneFailTwoAsserts,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_list_assertFailure_assertSuccess" ~:+       assertWithMsg "Prefix: " [assertFailure "Fail Message", assertSuccess],+     "assertWithMsg_list_assertFailure_assertSuccess", [], oneFailTwoAsserts,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assert_Pass" ~: assert Pass, "assert_Pass", [], oneAssert, []),+    ("assert_Fail" ~: assert (Fail "Fail Message"), "assert_Fail", [],+     oneFailOneAssert, [Utils.Failure "Fail Message"]),+    ("assert_Error" ~: assert (Error "Error Message"), "assert_Error", [],+     oneError, [Utils.Error "Error Message"]),+    ("assertWithMsg_Pass" ~: assertWithMsg "Prefix: " Pass,+     "assertWithMsg_Pass", [], oneAssert, []),+    ("assertWithMsg_Fail" ~: assertWithMsg "Prefix: " (Fail "Fail Message"),+     "assertWithMsg_Fail", [], oneFailOneAssert,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_Error" ~:+       assertWithMsg "Prefix: " (Error "Error Message"),+     "assertWithMsg_Error", [], oneError, [Utils.Error "Prefix: Error Message"]),+    ("assert_eventually_Pass" ~: assert (eventually Pass),+     "assert_eventually_Pass", [], oneAssert, []),+    ("assert_eventually_Fail" ~: assert (eventually (Fail "Fail Message")),+     "assert_eventually_Fail", [], oneFailOneAssert,+     [Utils.Failure "Fail Message"]),+    ("assert_eventually_Error" ~: assert (eventually (Error "Error Message")),+     "assert_eventually_Error", [], oneError, [Utils.Error "Error Message"]),+    ("assertWithMsg_eventually_Pass" ~: assert (eventually Pass),+     "assertWithMsg_eventually_Pass", [], oneAssert, []),+    ("assertWithMsg_eventually_Fail" ~:+       assertWithMsg "Prefix: " (eventually (Fail "Fail Message")),+     "assertWithMsg_eventually_Fail", [], oneFailOneAssert,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_eventually_Error" ~:+       assertWithMsg "Prefix: " (eventually (Error "Error Message")),+     "assertWithMsg_eventually_Error", [], oneError,+     [Utils.Error "Prefix: Error Message"]),+    -- Monadized assertable instances+    ("assert_return_Unit" ~: assert (return () :: IO ()),+     "assert_return_Unit", [], zeroCounts, []),+    ("assert_return_True" ~: assert (return True :: IO Bool),+     "assert_return_True", [], oneAssert, []),+    ("assert_return_False" ~: assert (return False :: IO Bool),+     "assert_return_False", [], oneFailOneAssert, [Utils.Failure ""]),+    ("assertWithMsg_return_True" ~:+       assertWithMsg "Message" (return True :: IO Bool),+     "assertWithMsg_return_True", [], oneAssert, []),+    ("assertWithMsg_return_False" ~:+       assertWithMsg "Message" (return False :: IO Bool),+     "assertWithMsg_return_False", [], oneFailOneAssert,+     [Utils.Failure "Message"]),+    ("assert_return_String_empty" ~: assert (return "" :: IO String),+     "assert_return_String_empty", [], oneAssert, []),+    ("assert_return_String_nonempty" ~: assert (return "non-empty" :: IO String),+     "assert_return_String_nonempty", [], oneFailOneAssert,+     [Utils.Failure "non-empty"]),+    ("assertWithMsg_return_String_empty" ~:+       assertWithMsg "Prefix: " (return "" :: IO String),+     "assertWithMsg_return_String_empty", [], oneAssert, []),+    ("assertWithMsg_return_String_nonempty" ~:+       assertWithMsg "Prefix: " (return "non-empty" :: IO String),+     "assertWithMsg_return_String_nonempty", [], oneFailOneAssert,+     [Utils.Failure "Prefix: non-empty"]),+    ("assert_return_list_assertSuccess_twice" ~:+       assert (return [assertSuccess, assertSuccess] :: IO [Assertion]),+     "assert_return_list_assertSuccess_twice", [], twoAsserts, []),+    ("assert_return_list_assertFailure_twice" ~:+       assert (return [assertFailure "Fail Message\n",+                       assertFailure "Fail Message 2\n"] :: IO [Assertion]),+     "assert_return_list_assertFailure_twice", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message\n", Utils.Failure "Fail Message 2\n"]),+    ("assert_return_list_assertSuccess_assertFailure" ~:+       assert (return [assertSuccess,+                       assertFailure "Fail Message"] :: IO [Assertion]),+     "assert_return_list_assertSuccess_assertFailure", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("assert_return_list_assertFailure_assertSuccess" ~:+       assert (return [assertFailure "Fail Message",+                       assertSuccess] :: IO [Assertion]),+     "assert_return_list_assertFailure_assertSuccess", [], oneFailTwoAsserts,+     [Utils.Failure "Fail Message"]),+    ("assertWithMsg_return_list_assertSuccess_twice" ~:+       assertWithMsg "Prefix: " (return [assertSuccess, assertSuccess]+                                 :: IO [Assertion]),+     "assertWithMsg_return_list_assertSuccess_twice", [], twoAsserts, []),+    ("assertWithMsg_return_list_assertFailure_twice" ~:+       assertWithMsg "Prefix: " (return [assertFailure "Fail Message\n",+                                         assertFailure "Fail Message 2\n"]+                                 :: IO [Assertion]),+     "assertWithMsg_return_list_assertFailure_twice", [], oneFailTwoAsserts,+     [Utils.Failure "Prefix: Fail Message\n",+      Utils.Failure "Prefix: Fail Message 2\n"]),+    ("assertWithMsg_return_list_assertSuccess_assertFailure" ~:+       assertWithMsg "Prefix: "(return [assertSuccess,+                                        assertFailure "Fail Message"]+                                :: IO [Assertion]),+     "assertWithMsg_return_list_assertSuccess_assertFailure",+     [], oneFailTwoAsserts, [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_return_list_assertFailure_assertSuccess" ~:+       assertWithMsg "Prefix: " (return [assertFailure "Fail Message",+                                         assertSuccess] :: IO [Assertion]),+     "assertWithMsg_return_list_assertFailure_assertSuccess",+     [], oneFailTwoAsserts, [Utils.Failure "Prefix: Fail Message"]),+    ("assert_return_Pass" ~: assert (return Pass :: IO Result),+     "assert_return_Pass", [], oneAssert, []),+    ("assert_return_Fail" ~: assert (return (Fail "Fail Message") :: IO Result),+     "assert_return_Fail", [], oneFailOneAssert, [Utils.Failure "Fail Message"]),+    ("assert_return_Error" ~:+       assert (return (Error "Error Message") :: IO Result),+     "assert_return_Error", [], oneError, [Utils.Error "Error Message"]),+    ("assertWithMsg_return_Pass" ~:+       assertWithMsg "Message" (return Pass :: IO Result),+     "assertWithMsg_return_Pass", [], oneAssert, []),+    ("assertWithMsg_return_Fail" ~:+       assertWithMsg "Prefix: " (return (Fail "Fail Message") :: IO Result),+     "assertWithMsg_return_Fail", [], oneFailOneAssert,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_return_Error" ~:+       assertWithMsg "Prefix: " (return (Error "Error Message") :: IO Result),+     "assertWithMsg_return_Error", [], oneError,+     [Utils.Error "Prefix: Error Message"]),+    ("assert_return_eventually_Pass" ~:+       assert (return (eventually Pass) :: IO Progress),+     "assert_return_eventually_Pass", [], oneAssert, []),+    ("assert_return_eventually_Fail" ~:+       assert (return (eventually (Fail "Fail Message")) :: IO Progress),+     "assert_return_eventually_Fail", [], oneFailOneAssert,+     [Utils.Failure "Fail Message"]),+    ("assert_return_eventually_Error" ~:+       assert (return (eventually (Error "Error Message")) :: IO Progress),+     "assert_return_eventually_Error", [], oneError,+     [Utils.Error "Error Message"]),+    ("assertWithMsg_return_eventually_Pass" ~:+       assertWithMsg "Prefix: " (return (eventually Pass) :: IO Progress),+     "assertWithMsg_return_eventually_Pass", [], oneAssert, []),+    ("assertWithMsg_return_eventually_Fail" ~:+       assertWithMsg "Prefix: " (return (eventually (Fail "Fail Message"))+                                 :: IO Progress),+     "assertWithMsg_return_eventually_Fail", [], oneFailOneAssert,+     [Utils.Failure "Prefix: Fail Message"]),+    ("assertWithMsg_return_eventually_Error" ~:+       assertWithMsg "Prefix: " (return (eventually (Error "Error Message"))+                                 :: IO Progress),+     "assertWithMsg_return_eventually_Error", [], oneError,+     [Utils.Error "Prefix: Error Message"]),+    -- Assertion operators+    ("assertWithMsg_operator_Pass" ~: True @? "Message",+     "assertWithMsg_operator_Pass", [], oneAssert, []),+    ("assertWithMsg_operator_False" ~: False @? "Message",+     "assertWithMsg_operator_False", [], oneFailOneAssert,+     [Utils.Failure "Message"]),+    ("assertWithMsg_operator_Fail" ~: Fail "Message" @? "Prefix: ",+     "assertWithMsg_operator_Fail", [], oneFailOneAssert,+     [Utils.Failure "Prefix: Message"]),+    ("assertWithMsg_operator_Error" ~: Error "Message" @? "Prefix: ",+     "assertWithMsg_operator_Error", [], oneError,+     [Utils.Error "Prefix: Message"]),+    ("assertEqual_operator_eq" ~: 10 @=? 10,+     "assertEqual_operator_eq", [], oneAssert, []),+    ("assertEqual_operator_neq" ~: 0 @=? 1, "assertEqual_operator_neq",+     [], oneFailOneAssert, [Utils.Failure "expected: 0\nbut got: 1"]),+    ("assertEqual_operator2_eq" ~: 7 @?= 7,+     "assertEqual_operator2_eq", [], oneAssert, []),+    ("assertEqual_operator2_neq" ~: 11 @=? 8, "assertEqual_operator2_neq",+     [], oneFailOneAssert, [Utils.Failure "expected: 11\nbut got: 8"]),+    -- Test-building functions+    ("HUnit_Test_empty" ~: (return () :: IO ()),+     "HUnit_Test_empty", [], zeroCounts, []),+    ("HUnit_Test_Progress_Pass" ~: (return (Finished Pass) :: IO Progress),+     "HUnit_Test_Progress_Pass", [], oneAssert, []),+    ("HUnit_Test_Progress_Fail" ~:+       (return (Finished (Fail "Fail Message")) :: IO Progress),+     "HUnit_Test_Progress_Fail", [], oneFailOneAssert,+     [Utils.Failure "Fail Message"]),+    ("HUnit_Test_Progress_Error" ~:+       (return (Finished (Error "Error Message")) :: IO Progress),+     "HUnit_Test_Progress_Error", [], oneError, [Utils.Error "Error Message"]),+    ("HUnit_Test_Progress_eventually_Pass" ~:+       (return (eventually Pass) :: IO Progress),+     "HUnit_Test_Progress_eventually_Pass", [], oneAssert, []),+    ("HUnit_Test_Progress_eventually_Fail" ~:+       (return (eventually (Fail "Fail Message")) :: IO Progress),+     "HUnit_Test_Progress_eventually_Fail", [], oneFailOneAssert,+     [Utils.Failure "Fail Message"]),+    ("HUnit_Test_Progress_eventually_Error" ~:+       (return (eventually (Error "Error Message")) :: IO Progress),+     "HUnit_Test_Progress_eventually_Error", [], oneError,+     [Utils.Error "Error Message"]),+    ("HUnit_Test_Bool_True" ~: (return True :: IO Bool),+     "HUnit_Test_Bool_True", [], oneAssert, []),+    ("HUnit_Test_Bool_False" ~: (return False :: IO Bool),+     "HUnit_Test_Bool_False", [], oneFailOneAssert, [Utils.Failure ""]),+    ("HUnit_Test_with_msg_True" ~: (True ~? "Failure Message"),+     "HUnit_Test_with_msg_True", [], oneAssert, []),+    ("HUnit_Test_with_msg_False" ~: (False ~? "Fail Message"),+     "HUnit_Test_with_msg_False", [], oneFailOneAssert,+     [Utils.Failure "Fail Message"]),+    ("HUnit_Eq_Test_eq" ~: (4 ~?= 4), "HUnit_Eq_Test_eq", [], oneAssert, []),+    ("HUnit_Eq_Test_neq" ~: (4 ~?= 5), "HUnit_Eq_Test_neq", [],+     oneFailOneAssert, [Utils.Failure "expected: 5\nbut got: 4"]),+    ("HUnit_Eq_Test2_eq" ~: (3 ~=? 3), "HUnit_Eq_Test2_eq", [], oneAssert, []),+    ("HUnit_Eq_Test2_neq" ~: (3 ~=? 2), "HUnit_Eq_Test2_neq", [],+     oneFailOneAssert, [Utils.Failure "expected: 3\nbut got: 2"]),+    (externalTestPass, "externalTestPass", [], zeroCounts, []),+    (externalTestEventuallyPass, "externalTestEventuallyPass", [], zeroCounts,+     [Utils.Progress ".", Utils.Progress "..", Utils.Progress "..."]),+    (externalTestFail, "externalTestFail", [], oneFail,+     [Utils.Failure "External Test Failed"]),+    (externalTestEventuallyFail, "externalTestEventuallyFail", [], oneFail,+     [Utils.Progress ".", Utils.Progress "..", Utils.Progress "...",+      Utils.Failure "External Test Failed"]),+    (externalTestError, "externalTestError", [], oneError,+     [Utils.Error "External Test Error"]),+    (externalTestEventuallyError, "externalTestEventuallyError", [], oneError,+     [Utils.Progress ".", Utils.Progress "..", Utils.Progress "...",+      Utils.Error "External Test Error"]),+    (externalTestException, "externalTestException", [], oneError,+     [Utils.Exception "Exception Message"]),+    -- Test manipulation of tags and test names+    (testName "newName" (test (return () :: IO ())),+     "newName", [], zeroCounts, []),+    (testTags ["tag", "gat"] ("newTags" ~: (return () :: IO ())),+     "newTags", ["tag", "gat"], zeroCounts, []),+    (testNameTags "newNameTags" ["tag", "gat"] (test (return () :: IO ())),+     "newNameTags", ["tag", "gat"], zeroCounts, [])+  ]+{-+miscTests :: [Test]+miscTests =+  let+    anonTest1 = test True+    anonTest2 = test True++    tagsTest1 = testTags ["tag"] True+    tagsTest2 = testTags ["tag", "gat"] True++    nameTest = testName "test1" True++    anonTestCreate =+      TestInstance { name = "anonTestCreate", tags = [], options = [],+                     setOption = (\_ _ -> anonTestCreate),+                     run = if (name anonTest1) /= (name anonTest2)+                             then return (Finished Pass)+                             else+                               return (Finished (Fail "expected unique names")) }+    tagsTestCreate+  in+    [ Test anontestCreate, Test tagsTestCreate ]+-}+tests :: Test+tests = testGroup "Base" (map makeTestCase testCases)

@@ -0,0 +1,667 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}+module Tests.Test.HUnitPlus.Execution where++import Control.Exception(Exception, throwIO)+import Data.List+import Data.HashMap.Strict(HashMap)+import Data.Maybe+import Data.Typeable+import Distribution.TestSuite+import Test.HUnitPlus.Base+import Test.HUnitPlus.Execution+import Test.HUnitPlus.Filter+import Test.HUnitPlus.Reporting++import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict++data ReportEvent =+    EndEvent Counts+  | StartSuiteEvent State+  | EndSuiteEvent State+  | StartCaseEvent State+  | EndCaseEvent State+  | SkipEvent State+  | ProgressEvent Strict.Text State+  | FailureEvent Strict.Text State+  | ErrorEvent Strict.Text State+  | SystemErrEvent Strict.Text State+  | SystemOutEvent Strict.Text State+    deriving (Eq, Show)++fullLoggingReporter :: Reporter [ReportEvent]+fullLoggingReporter = defaultReporter {+    reporterStart = return [],+    reporterEnd =+      \_ ss events -> return $ (EndEvent ss :events),+    reporterStartSuite =+      \ss events -> return $ (StartSuiteEvent ss : events),+    reporterEndSuite =+      \_ ss events -> return $ (EndSuiteEvent ss : events),+    reporterStartCase =+      \ss events -> return $ (StartCaseEvent ss : events),+    reporterEndCase =+      \_ ss events -> return $ (EndCaseEvent ss : events),+    reporterSkipCase =+      \ss events -> return $ (SkipEvent ss : events),+    reporterCaseProgress =+      \msg ss events -> return $ (ProgressEvent msg ss : events),+    reporterFailure =+      \msg ss events -> return $ (FailureEvent msg ss : events),+    reporterError =+      \msg ss events -> return $ (ErrorEvent msg ss : events),+    reporterSystemErr =+      \msg ss events -> return $ (SystemErrEvent msg ss : events),+    reporterSystemOut =+      \msg ss events -> return $ (SystemOutEvent msg ss : events)+  }++makeTagName False False = "no_tag"+makeTagName True False = "tag1"+makeTagName False True = "tag2"+makeTagName True True = "tag12"++makeTagSet (False, False) = HashSet.empty+makeTagSet (True, False) = HashSet.singleton "tag1"+makeTagSet (False, True) = HashSet.singleton "tag2"+makeTagSet (True, True) = HashSet.fromList ["tag1", "tag2"]++data TestException = TestException+  deriving (Show, Typeable)++instance Exception TestException++data Behavior = Normal Result | Exception++makeResName (Normal Pass) = "pass"+makeResName (Normal (Fail _)) = "fail"+makeResName (Normal (Error _)) = "error"+makeResName Exception = "exception"++makeAssert (Normal Pass) = assertSuccess+makeAssert (Normal (Fail msg)) = assertFailure (Strict.pack msg)+makeAssert (Normal (Error msg)) = abortError (Strict.pack msg)+makeAssert Exception = throwIO TestException++updateCounts (Normal Pass) c @ Counts { cAsserts = asserts } =+  c { cAsserts = asserts + 1, cCaseAsserts = 1 }+updateCounts (Normal (Fail _)) c @ Counts { cFailures = fails,+                                            cAsserts = asserts } =+  c { cFailures = fails + 1, cAsserts = asserts + 1, cCaseAsserts = 1 }+updateCounts (Normal (Error _)) c @ Counts { cErrors = errors } =+  c { cErrors = errors + 1, cCaseAsserts = 0 }+updateCounts Exception c @ Counts { cErrors = errors } =+  c { cErrors = errors + 1, cCaseAsserts = 0 }++makeName :: (Bool, Bool, Behavior) -> Strict.Text+makeName (tag1, tag2, res) =+  Strict.concat [makeTagName tag1 tag2, "_", makeResName res]++makeTest :: String -> (Bool, Bool, Behavior) -> Test+makeTest prefix tdata @ (tag1, tag2, res) =+  let+    inittags = if tag1 then ["tag1"] else []+    tags = if tag2 then "tag2" : inittags else inittags+    testname = prefix ++ (Strict.unpack (makeName tdata))+  in+    testNameTags testname tags (makeAssert res)+{-++    testInstance = TestInstance { name = testname, tags = tags,+                                  setOption = (\_ _ -> Right testInstance),+                                  options = [], run = runTest }+  in+    Test testInstance+-}+makeTestData :: String -> ([Test], [ReportEvent], State) ->+                Either (Bool, Bool, Behavior) (Bool, Bool, Behavior) ->+                ([Test], [ReportEvent], State)+makeTestData prefix+             (tests, events,+              ss @ State { stName = oldname,+                           stCounts = counts @ Counts { cCases = cases,+                                                        cTried = tried } })+             (Right tdata @ (tag1, tag2, res)) =+  let+    startedCounts = counts { cCases = cases + 1, cTried = tried + 1 }+    finishedCounts = updateCounts res startedCounts+    ssWithName = ss { stName = Strict.concat [Strict.pack prefix, makeName tdata] }+    ssStarted = ssWithName { stCounts = startedCounts }+    ssFinished = ssWithName { stCounts = finishedCounts }+    -- Remember, the order is reversed for these, because we reverse+    -- the events list in the end.+    newevents =+      case res of+        Normal Pass ->+          EndCaseEvent ssFinished : StartCaseEvent ssStarted : events+        Normal (Fail msg) ->+          EndCaseEvent ssFinished : FailureEvent (Strict.pack msg) ssStarted :+          StartCaseEvent ssStarted : events+        Normal (Error msg) ->+          EndCaseEvent ssFinished : ErrorEvent (Strict.pack msg) ssStarted :+          StartCaseEvent ssStarted : events+        Exception ->+          EndCaseEvent ssFinished :+          ErrorEvent "Uncaught exception in test: TestException" ssStarted :+          StartCaseEvent ssStarted : events+  in+    (makeTest prefix tdata : tests, newevents,+     ssFinished { stName = oldname })+makeTestData prefix+             (tests, events, ss @ State { stCounts =+                                             c @ Counts { cSkipped = skipped,+                                                          cCases = cases },+                                          stName = oldname })+             (Left tdata) =+  let+    newcounts = c { cCases = cases + 1, cSkipped = skipped + 1 }+    newstate = ss { stCounts = newcounts,+                    stName = Strict.concat [Strict.pack prefix, makeName tdata] }+  in+    (makeTest prefix tdata : tests, SkipEvent newstate : events,+     newstate { stName = oldname })++resultVals :: [Behavior]+resultVals = [Normal Pass, Normal (Fail "Fail Message"),+              Normal (Error "Error Message"), Exception]+++tagVals :: [Bool]+tagVals = [True, False]++testData :: [(Bool, Bool, Behavior)]+testData = foldl (\accum tag1 ->+                   foldl (\accum tag2 ->+                           foldl (\accum res -> (tag1, tag2, res) : accum)+                                 accum resultVals)+                         accum tagVals)+                 [] tagVals++tag1Filter tdata @ (True, _, _) = Right tdata+tag1Filter tdata = Left tdata++tag2Filter tdata @ (_, True, _) = Right tdata+tag2Filter tdata = Left tdata++tag12Filter tdata @ (True, _, _) = Right tdata+tag12Filter tdata @ (_, True, _) = Right tdata+tag12Filter tdata = Left tdata++data ModFilter = All | WithTags (Bool, Bool) | None deriving Show++getTests :: ModFilter -> [Either (Bool, Bool, Behavior) (Bool, Bool, Behavior)]+getTests All = map Right testData+getTests (WithTags (True, False)) = map tag1Filter testData+getTests (WithTags (False, True)) = map tag2Filter testData+getTests (WithTags (True, True)) = map tag12Filter testData+getTests None = map Left testData++-- Generate a list of all mod filters we can use for a sub-module, and+-- the selectors we need for them+getSuperSet :: (Selector -> Selector) -> ModFilter ->+               [(ModFilter, Selector, Bool)]+-- If we're already running all tests, there's nothing else we can do+getSuperSet wrapinner All =+  [(All, wrapinner (allSelector { selectorTags = Nothing }), False)]+-- If we're running tests with both tags, we can do that, or we can+-- run all tests in the submodule.+getSuperSet wrapinner (WithTags (True, True)) =+  [(WithTags (True, True),+    wrapinner (allSelector { selectorTags = Nothing }), False),+   (All, wrapinner allSelector, True)]+-- If we're running tests with one of the tags, we can do that, or we+-- can run with both tags, or we can run all tests.+getSuperSet wrapinner (WithTags (False, True)) =+  [(WithTags (False, True),+    wrapinner (allSelector { selectorTags = Nothing }), False),+   (WithTags (True, True),+    wrapinner (allSelector { selectorTags =+                                   Just $! HashSet.fromList ["tag1", "tag2" ] }),+    True),+   (All, wrapinner allSelector, True) ]+getSuperSet wrapinner (WithTags (True, False)) =+  [(WithTags (True, False),+    wrapinner (allSelector { selectorTags = Nothing }), False),+   (WithTags (True, True),+    wrapinner (allSelector { selectorTags =+                                   Just $! HashSet.fromList ["tag1", "tag2" ] }),+    True),+   (All, wrapinner allSelector, True) ]+-- If we're not running any tests, we can do anything+getSuperSet wrapinner None =+  [(None, wrapinner (allSelector { selectorTags = Nothing }), False),+   (WithTags (True, False),+    wrapinner (allSelector { selectorTags = Just $! HashSet.singleton "tag1" }),+    True),+   (WithTags (False, True),+    wrapinner (allSelector { selectorTags = Just $! HashSet.singleton "tag2" }),+    True),+   (WithTags (True, True),+    wrapinner (allSelector { selectorTags =+                                   Just $! HashSet.fromList ["tag1", "tag2" ] }),+    True),+   (All, wrapinner allSelector, True) ]++-- Make the tests for a group, with a starting modfilter+makeLeafGroup :: String -> (Selector -> Selector) -> ModFilter ->+                 ([Test], [ReportEvent], State, [Selector]) ->+                 [([Test], [ReportEvent], State, [Selector])]+makeLeafGroup gname wrapinner mfilter initialTests =+  let+    mapfun :: ([Test], [ReportEvent], State, [Selector]) ->+              (ModFilter, Selector, Bool) ->+              ([Test], [ReportEvent], State, [Selector])+    mapfun (tests, events, ss @ State { stPath = oldpath }, selectors)+           (mfilter, selector, valid) =+      let+        ssWithPath = ss { stPath = Label (Strict.pack gname) : oldpath }+        (grouptests, events', ss') =+          foldl (makeTestData (gname ++ "_"))+                ([], events, ssWithPath)+                (getTests mfilter)+        tests' = Group { groupName = gname, groupTests = reverse grouptests,+                         concurrently = True } : tests+      in+        if valid+          then (tests', events', ss' { stPath = oldpath }, selector : selectors)+          else (tests', events', ss' { stPath = oldpath }, selectors)+  in+    map (mapfun initialTests) (getSuperSet wrapinner mfilter)++makeOuterGroup :: ModFilter -> ([Test], [ReportEvent], State, [Selector]) ->+                  [([Test], [ReportEvent], State, [Selector])]+makeOuterGroup mfilter initialTests =+  let+    wrapOuterPath inner =+      Selector { selectorInners = HashMap.singleton "Outer" inner,+                 selectorTags = Nothing }++    mapfun :: ([Test], [ReportEvent], State, [Selector]) ->+              (ModFilter, Selector, Bool) ->+              [([Test], [ReportEvent], State, [Selector])]+    mapfun (tests, events, ss @ State { stPath = oldpath }, selectors)+           (mfilter, selector, valid) =+      let+        ssWithPath = ss { stPath = Label "Outer" : oldpath }++        mapfun :: ([Test], [ReportEvent], State, [Selector]) ->+                  ([Test], [ReportEvent], State, [Selector])+        mapfun (innergroup : tests, events, ss, selectors) =+          let+            (grouptests, events', ss') = foldl (makeTestData "Outer_")+                                               ([innergroup], events, ss)+                                               (getTests mfilter)++            tests' = Group { groupName = "Outer",+                             groupTests = reverse grouptests,+                             concurrently = True } : tests+          in+            if valid+              then (tests', events', ss' { stPath = oldpath },+                    selector : selectors)+              else (tests', events', ss' { stPath = oldpath }, selectors)++        wrapInnerPath inner =+          Selector {+            selectorInners =+               HashMap.singleton "Outer" Selector {+                                       selectorInners =+                                          HashMap.singleton "Inner" inner,+                                       selectorTags = Nothing+                                     },+            selectorTags = Nothing+          }++        withInner :: [([Test], [ReportEvent], State, [Selector])]+        withInner = makeLeafGroup "Inner" wrapInnerPath mfilter+                                  (tests, events, ssWithPath, selectors)+      in+        map mapfun withInner++  in+    concatMap (mapfun initialTests) (getSuperSet wrapOuterPath mfilter)++modfilters = [ All, WithTags (True, False), WithTags (False, True),+               WithTags (True, True), None ]++genFilter :: Strict.Text+          -> [(TestSuite, [ReportEvent],+               HashMap Strict.Text (HashMap OptionMap Selector), Counts)]+genFilter sname =+  let+    -- Take a root ModFilter and an initial (suite list, event list,+    -- selectors).  We generate a stock suite, derive a selector from+    -- the root ModFilter, and produce a list of possible (suite list,+    -- event list, selectors)'s, one for each possibility.+    suiteTestInst :: ModFilter+                  -> [(TestSuite, [ReportEvent],+                       HashMap Strict.Text (HashMap OptionMap Selector),+                       Counts)]+    suiteTestInst mfilter =+      let+        -- Initial state for a filter+        initState = State { stCounts = zeroCounts, stName = sname,+                            stPath = [], stOptions = HashMap.empty,+                            stOptionDescs = [] }++        -- The selectors for the root set+        rootSelectors :: [Selector]+        rootSelectors =+          case mfilter of+            All -> [allSelector]+            WithTags tags ->+              [allSelector { selectorTags = Just $! makeTagSet tags }]+            None -> []++        -- Result after executing the root tests.+        (rootTests, rootEvents, rootState) =+          foldl (makeTestData "") ([], [StartSuiteEvent initState], initState)+                (getTests mfilter)++        wrapOtherPath inner =+          Selector { selectorInners = HashMap.singleton "Other" inner,+                     selectorTags = Nothing }++        -- Results after executing tests in the Other module+        withOther :: [([Test], [ReportEvent], State, [Selector])]+        withOther = makeLeafGroup "Other" wrapOtherPath mfilter+                                  (rootTests, rootEvents,+                                   rootState, rootSelectors)++        finalData = concatMap (makeOuterGroup mfilter) withOther++        -- Wrap up a test list, end state, and selector list into a+        -- test suite and a filter.  Also add the EndSuite event to+        -- the events list.+        buildSuite :: ([Test], [ReportEvent], State, [Selector]) ->+                      (TestSuite, [ReportEvent],+                       HashMap Strict.Text (HashMap OptionMap Selector),+                       Counts)+        buildSuite (tests, _, _, []) =+          let+            suite =+              TestSuite { suiteName = sname, suiteTests = reverse tests,+                          suiteConcurrently = True, suiteOptions = [] }+          in+            (suite, [], HashMap.empty, zeroCounts)+        buildSuite (tests, events, state @ State { stCounts = counts },+                    selectors) =+          let+            -- Build the test suite out of the name and test list, add+            -- it to the list of suites.+            suite =+              TestSuite { suiteName = sname, suiteTests = reverse tests,+                          suiteConcurrently = True, suiteOptions = [] }++            -- Add an end suite event+            eventsWithEnd = EndSuiteEvent state : events++            -- Add an entry for this suite to the selector map+            selectormap :: HashMap Strict.Text (HashMap OptionMap Selector)+            selectormap =+              case selectors of+                [one] ->+                  let+                    optmap = HashMap.singleton HashMap.empty one+                  in+                    HashMap.singleton sname optmap+                _ ->+                  let+                    combined = foldl1 combineSelectors selectors+                    optmap = HashMap.singleton HashMap.empty combined+                  in+                    HashMap.singleton sname optmap+          in+            (suite, reverse eventsWithEnd, selectormap, counts)+      in+        map buildSuite finalData+  in+    -- Create test data for this suite with all possible modfilters,+    -- and add it to the existing list of test instances.+    concatMap suiteTestInst modfilters++suite1Data :: [(TestSuite, [ReportEvent],+                HashMap Strict.Text (HashMap OptionMap Selector), Counts)]+suite1Data = genFilter "Suite1"++suite2Data :: [(TestSuite, [ReportEvent],+                HashMap Strict.Text (HashMap OptionMap Selector), Counts)]+suite2Data = genFilter "Suite2"++combineSuites :: (TestSuite, [ReportEvent],+                  HashMap Strict.Text (HashMap OptionMap Selector), Counts) ->+                 (TestSuite, [ReportEvent],+                  HashMap Strict.Text (HashMap OptionMap Selector), Counts) ->+                 ([TestSuite], [ReportEvent],+                  HashMap Strict.Text (HashMap OptionMap Selector))+combineSuites (suite1, events1, selectormap1, Counts { cAsserts = asserts1,+                                                       cCases = cases1,+                                                       cErrors = errors1,+                                                       cFailures = failures1,+                                                       cSkipped = skipped1,+                                                       cTried = tried1 })+              (suite2, events2, selectormap2, counts2) =+  let+    bumpCounts (EndEvent c @ Counts { cAsserts = asserts2,+                                      cCases = cases2,+                                      cErrors = errors2,+                                      cFailures = failures2,+                                      cSkipped = skipped2,+                                      cTried = tried2 }) =+      EndEvent c { cAsserts = asserts1 + asserts2,+                   cErrors = errors1 + errors2,+                   cCases = cases1 + cases2,+                   cFailures = failures1 + failures2,+                   cSkipped = skipped1 + skipped2,+                   cTried = tried1 + tried2 }+    bumpCounts (StartSuiteEvent s @ State { stCounts =+                                              c @ Counts { cAsserts = asserts2,+                                                           cCases = cases2,+                                                           cErrors = errors2,+                                                           cFailures = failures2,+                                                           cSkipped = skipped2,+                                                           cTried = tried2 } }) =+      StartSuiteEvent s { stCounts = c { cAsserts = asserts1 + asserts2,+                                         cErrors = errors1 + errors2,+                                         cCases = cases1 + cases2,+                                         cFailures = failures1 + failures2,+                                         cSkipped = skipped1 + skipped2,+                                         cTried = tried1 + tried2 } }+    bumpCounts (EndSuiteEvent s @ State { stCounts =+                                            c @ Counts { cAsserts = asserts2,+                                                         cCases = cases2,+                                                         cErrors = errors2,+                                                         cFailures = failures2,+                                                         cSkipped = skipped2,+                                                         cTried = tried2 } }) =+      EndSuiteEvent s { stCounts = c { cAsserts = asserts1 + asserts2,+                                       cErrors = errors1 + errors2,+                                       cCases = cases1 + cases2,+                                       cFailures = failures1 + failures2,+                                       cSkipped = skipped1 + skipped2,+                                       cTried = tried1 + tried2 } }+    bumpCounts (StartCaseEvent s @ State { stCounts =+                                             c @ Counts { cAsserts = asserts2,+                                                          cCases = cases2,+                                                          cErrors = errors2,+                                                          cFailures = failures2,+                                                          cSkipped = skipped2,+                                                          cTried = tried2 } }) =+      StartCaseEvent s { stCounts = c { cAsserts = asserts1 + asserts2,+                                        cErrors = errors1 + errors2,+                                        cCases = cases1 + cases2,+                                        cFailures = failures1 + failures2,+                                        cSkipped = skipped1 + skipped2,+                                        cTried = tried1 + tried2 } }+    bumpCounts (EndCaseEvent s @ State { stCounts =+                                           c @ Counts { cAsserts = asserts2,+                                                        cCases = cases2,+                                                        cErrors = errors2,+                                                        cFailures = failures2,+                                                        cSkipped = skipped2,+                                                        cTried = tried2 } }) =+      EndCaseEvent s { stCounts = c { cAsserts = asserts1 + asserts2,+                                      cErrors = errors1 + errors2,+                                      cCases = cases1 + cases2,+                                      cFailures = failures1 + failures2,+                                      cSkipped = skipped1 + skipped2,+                                      cTried = tried1 + tried2 } }+    bumpCounts (SkipEvent s @ State { stCounts =+                                        c @ Counts { cAsserts = asserts2,+                                                     cCases = cases2,+                                                     cErrors = errors2,+                                                     cFailures = failures2,+                                                     cSkipped = skipped2,+                                                     cTried = tried2 } }) =+      SkipEvent s { stCounts = c { cAsserts = asserts1 + asserts2,+                                   cErrors = errors1 + errors2,+                                   cCases = cases1 + cases2,+                                   cFailures = failures1 + failures2,+                                   cSkipped = skipped1 + skipped2,+                                   cTried = tried1 + tried2 } }+    bumpCounts (ProgressEvent msg s @ State { stCounts =+                                                c @ Counts { cAsserts = asserts2,+                                                             cCases = cases2,+                                                             cErrors = errors2,+                                                             cFailures = failures2,+                                                             cSkipped = skipped2,+                                                             cTried = tried2 } }) =+      ProgressEvent msg s { stCounts = c { cAsserts = asserts1 + asserts2,+                                           cErrors = errors1 + errors2,+                                           cCases = cases1 + cases2,+                                           cFailures = failures1 + failures2,+                                           cSkipped = skipped1 + skipped2,+                                           cTried = tried1 + tried2 } }+    bumpCounts (FailureEvent msg s @ State { stCounts =+                                               c @ Counts { cAsserts = asserts2,+                                                            cCases = cases2,+                                                            cErrors = errors2,+                                                            cFailures = failures2,+                                                            cSkipped = skipped2,+                                                            cTried = tried2 } }) =+      FailureEvent msg s { stCounts = c { cAsserts = asserts1 + asserts2,+                                          cErrors = errors1 + errors2,+                                          cCases = cases1 + cases2,+                                          cFailures = failures1 + failures2,+                                          cSkipped = skipped1 + skipped2,+                                          cTried = tried1 + tried2 } }+    bumpCounts (ErrorEvent msg s @ State { stCounts =+                                             c @ Counts { cAsserts = asserts2,+                                                          cCases = cases2,+                                                          cErrors = errors2,+                                                          cFailures = failures2,+                                                          cSkipped = skipped2,+                                                          cTried = tried2 } }) =+      ErrorEvent msg s { stCounts = c { cAsserts = asserts1 + asserts2,+                                        cErrors = errors1 + errors2,+                                        cCases = cases1 + cases2,+                                        cFailures = failures1 + failures2,+                                        cSkipped = skipped1 + skipped2,+                                        cTried = tried1 + tried2 } }+    bumpCounts (SystemErrEvent msg s @ State { stCounts =+                                                 c @ Counts { cAsserts = asserts2,+                                                              cCases = cases2,+                                                              cErrors = errors2,+                                                              cFailures = failures2,+                                                              cSkipped = skipped2,+                                                              cTried = tried2 } }) =+      SystemErrEvent msg s { stCounts = c { cAsserts = asserts1 + asserts2,+                                            cErrors = errors1 + errors2,+                                            cCases = cases1 + cases2,+                                            cFailures = failures1 + failures2,+                                            cSkipped = skipped1 + skipped2,+                                            cTried = tried1 + tried2 } }+    bumpCounts (SystemOutEvent msg s @ State { stCounts =+                                                 c @ Counts { cAsserts = asserts2,+                                                              cCases = cases2,+                                                              cErrors = errors2,+                                                              cFailures = failures2,+                                                              cSkipped = skipped2,+                                                              cTried = tried2 } }) =+      SystemOutEvent msg s { stCounts = c { cAsserts = asserts1 + asserts2,+                                            cErrors = errors1 + errors2,+                                            cCases = cases1 + cases2,+                                            cFailures = failures1 + failures2,+                                            cSkipped = skipped1 + skipped2,+                                            cTried = tried1 + tried2 } }++    suites = [suite1, suite2]+    events = events1 ++ map bumpCounts events2 +++             [bumpCounts (EndEvent counts2 { cCaseAsserts = 0 })]+    selectormap = HashMap.union selectormap1 selectormap2+  in+    (suites, events, selectormap)+++suiteData :: [([TestSuite], [ReportEvent],+               HashMap Strict.Text (HashMap OptionMap Selector))]+suiteData = foldl (\accum suite1 ->+                    foldl (\accum suite2 ->+                            (combineSuites suite1 suite2) : accum)+                          accum suite2Data)+                  [] suite1Data++makeExecutionTest :: ([TestSuite], [ReportEvent],+                      HashMap Strict.Text (HashMap OptionMap Selector)) ->+                     (Int, [Test]) -> (Int, [Test])+makeExecutionTest (suites, expected, selectors) (index, tests) =+  let+    format events = intercalate "\n" (map show events)++    selectorStrs =+      intercalate "\n" (map (\(suite, selector) -> "[" ++ Strict.unpack suite +++                                                   "]" ++ show selector)+                            (HashMap.toList selectors))++    compstate State { stName = name1, stPath = path1, stCounts = counts1,+                      stOptionDescs = descs1 }+              State { stName = name2, stPath = path2, stCounts = counts2,+                      stOptionDescs = descs2 } =+      name1 == name2 && path1 == path2 && counts1 == counts2 && descs1 == descs2++    comp (EndEvent counts1) (EndEvent counts2) = counts1 == counts2+    comp (StartSuiteEvent st1) (StartSuiteEvent st2) = compstate st1 st2+    comp (EndSuiteEvent st1) (EndSuiteEvent st2) = compstate st1 st2+    comp (StartCaseEvent st1) (StartCaseEvent st2) = compstate st1 st2+    comp (EndCaseEvent st1) (EndCaseEvent st2) = compstate st1 st2+    comp (SkipEvent st1) (SkipEvent st2) = compstate st1 st2+    comp (ProgressEvent msg1 st1) (ProgressEvent msg2 st2) =+      msg1 == msg2 && compstate st1 st2+    comp (FailureEvent msg1 st1) (FailureEvent msg2 st2) =+      msg1 == msg2 && compstate st1 st2+    comp (ErrorEvent msg1 st1) (ErrorEvent msg2 st2) =+      msg1 == msg2 && compstate st1 st2+    comp (SystemErrEvent msg1 st1) (SystemErrEvent msg2 st2) =+      msg1 == msg2 && compstate st1 st2+    comp (SystemOutEvent msg1 st1) (SystemOutEvent msg2 st2) =+      msg1 == msg2 && compstate st1 st2+    comp _ _ = False++    check (e : expecteds) (a : actuals)+      | comp e a = check expecteds actuals+      | otherwise =+        return (Finished (Fail ("Selectors\n" ++ selectorStrs +++                                "\nExpected\n************************\n" +++                                show e +++                                "\nbut got\n************************\n" +++                                show a)))+    check [] [] = return (Finished Pass)+    check expected [] =+      return (Finished (Fail ("Missing output:\n" ++ format expected)))+    check [] actual =+      return (Finished (Fail ("Extra output:\n" ++ format actual)))++    runTest =+      do+        (_, actual) <- performTestSuites fullLoggingReporter selectors suites+        check expected (reverse actual)++    testInstance = TestInstance { name = "execution_test_" ++ show index,+                                  tags = [], options = [], run = runTest,+                                  setOption = (\_ _ -> Right testInstance) }+  in+    (index + 1, Test testInstance : tests)++tests :: Test+tests = testGroup "Execution" (snd (foldr makeExecutionTest (0, []) suiteData))

@@ -0,0 +1,1006 @@+{-# LANGUAGE OverloadedStrings #-}++module Tests.Test.HUnitPlus.Filter(tests) where++import Data.List+import Data.HashMap.Strict(HashMap)+import Distribution.TestSuite+import Test.HUnitPlus.Filter++import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet+import qualified Data.Text as Strict++suiteNames :: [[String]]+suiteNames = [[], ["Suite1"], ["Suite1"], ["Suite1", "Suite2"]]++paths :: [[String]]+paths = [[], ["Outer"], ["Outer", "Middle"], ["Outer", "Middle", "Inner"],+         ["Underscore_path"], ["t__", "__u__", "__v"]]++tagNames :: [[String]]+tagNames = [[], ["tag1"], ["tag2"], ["tag1", "tag2"], ["underscore_tag"],+            ["t__", "_u__", "__v"]]++suiteString :: [String] -> String+suiteString [] = ""+suiteString suites = "[" ++ intercalate "," suites ++ "]"++pathString :: [String] -> String+pathString [] = ""+pathString path = intercalate "." path++tagsString :: [String] -> String+tagsString [] = ""+tagsString tags = '@' : intercalate "," tags++makeFilterString :: [String] -> [String] -> [String] -> String+makeFilterString suites path tags =+  suiteString suites ++ pathString path ++ tagsString tags++tagsSelector :: [String] -> Selector+tagsSelector [] = allSelector+tagsSelector tags =+  allSelector { selectorTags = Just $! HashSet.fromList (map Strict.pack tags) }++pathSelector :: Selector -> [Strict.Text] -> Selector+pathSelector inner [] = inner+pathSelector inner (elem : path) =+  Selector { selectorInners = HashMap.singleton elem (pathSelector inner path),+             selectorTags = Nothing }++makeFilter :: [Strict.Text] -> Selector -> Filter+makeFilter names selector =+  Filter { filterSuites = HashSet.fromList names, filterOptions = HashMap.empty,+           filterSelector = HashSet.singleton selector }++suitesName :: [String] -> String+suitesName [] = "no_suites"+suitesName suites = intercalate "_" suites++pathName :: [String] -> String+pathName [] = "no_path"+pathName path = intercalate "_" path++tagsName :: [String] -> String+tagsName [] = "no_tags"+tagsName tags = intercalate "_" tags++makeFilterParseTest :: [String] -> [String] -> [String] -> Test+makeFilterParseTest suites path tags =+  let+    name = suitesName suites ++ "__" ++ pathName path ++ "__" ++ tagsName tags+    string = suiteString suites ++ pathString path ++ tagsString tags+    expected = makeFilter (map Strict.pack suites)+                          (pathSelector (tagsSelector tags)+                                        (map Strict.pack path))++    runTest :: IO Progress+    runTest =+      do case parseFilter "test input" (Strict.pack string) of+          Left e -> return (Finished (Fail ("Parse of " ++ string +++                                            " failed: " ++ (Strict.unpack e))))+          Right actual+            | expected == actual -> return (Finished Pass)+            | otherwise ->+              return (Finished (Fail ("In parse of " ++ string +++                                      "\nexpected " ++ show expected +++                                      "\nactual " ++ show actual)))++    testInstance = TestInstance { name = name, run = runTest,+                                  tags = [], options = [],+                                  setOption = (\_ _ -> Right testInstance) }+  in+    Test testInstance++filterComponents :: [([String], [String], [String])]+filterComponents =+  foldl (\tests suiteName ->+          foldl (\tests path ->+                  foldl (\tests tag -> (suiteName, path, tag) : tests)+                        tests tagNames)+                tests paths)+        [] suiteNames++whitespaceStrings :: [String]+whitespaceStrings = [ "", " ", "\t" ]++commentStrings = [ "#", "# [Suite]"]++filterParseTests :: [Test]+filterParseTests = map (\(suiteName, path, tag) ->+                         makeFilterParseTest suiteName path tag)+                       filterComponents++makeFileParserTest :: String -> String -> [Filter] -> Test+makeFileParserTest name content expected =+  let+    runTest :: IO Progress+    runTest =+      do case parseFilterFileContent name (Strict.pack content) of+          Left e -> return (Finished (Fail ("Parse of\n************\n" +++                                            content +++                                            "\n************\nfailed: " +++                                            concat (map Strict.unpack e))))+          Right actual+            | expected == actual -> return (Finished Pass)+            | otherwise ->+              return (Finished (Fail ("In parse of\n************\n" +++                                      content +++                                      "\n************\nexpected " +++                                      show expected ++ "\nactual " +++                                      show actual)))++    testInstance =+      TestInstance { name = name, tags = [], run = runTest, options = [],+                     setOption = (\_ _ -> Right testInstance) }+  in+    Test testInstance++fileTests :: [(String, String, [Filter])]+fileTests =+  let+    simplePath =+      Selector {+        selectorTags = Nothing,+        selectorInners =+          HashMap.singleton "Outer"+            Selector { selectorTags = Nothing,+                       selectorInners = HashMap.singleton "Inner" allSelector }+      }+    simplePathStr = "Outer.Inner"++    onlyTags = allSelector { selectorTags =+                                Just $! HashSet.fromList ["tag1", "tag2"] }+    onlyTagsStr = "@tag1,tag2"+    pathTags =+      Selector {+        selectorTags = Nothing,+        selectorInners =+          HashMap.singleton "Outer"+            Selector { selectorTags = Nothing,+                       selectorInners = HashMap.singleton "Inner" onlyTags }+      }+    pathTagsStr = "Outer.Inner@tag1,tag2"+    suiteAllFilter = Filter { filterSuites = HashSet.fromList ["Suite1",+                                                               "Suite2"],+                              filterOptions = HashMap.empty,+                              filterSelector = HashSet.singleton allSelector }+    suiteFilterStr = "[Suite1,Suite2]"+    simplePathFilter = Filter { filterSuites = HashSet.empty,+                                filterOptions = HashMap.empty,+                                filterSelector = HashSet.singleton simplePath }+    suitePathFilter = Filter { filterSuites = HashSet.fromList ["Suite1",+                                                                "Suite2"],+                               filterOptions = HashMap.empty,+                               filterSelector = HashSet.singleton simplePath }+    suitePathStr = suiteFilterStr ++ simplePathStr+    onlyTagsFilter = Filter { filterSuites = HashSet.empty,+                              filterOptions = HashMap.empty,+                              filterSelector = HashSet.singleton onlyTags }+    suiteTagsFilter = Filter { filterSuites = HashSet.fromList ["Suite1",+                                                                "Suite2"],+                               filterOptions = HashMap.empty,+                               filterSelector = HashSet.singleton onlyTags }+    suiteTagsStr = suiteFilterStr ++ onlyTagsStr+    pathTagsFilter = Filter { filterSuites = HashSet.empty,+                              filterOptions = HashMap.empty,+                              filterSelector = HashSet.singleton pathTags }+    suitePathTagsFilter =+      Filter { filterSuites = HashSet.fromList ["Suite1", "Suite2"],+               filterOptions = HashMap.empty,+               filterSelector = HashSet.singleton pathTags }+    suitePathTagsStr = suiteFilterStr ++ pathTagsStr++    suiteSequenceStrs = [ simplePathStr,+                          onlyTagsStr,+                          pathTagsStr,+                          suiteFilterStr,+                          suitePathStr,+                          suiteTagsStr,+                          suitePathTagsStr ]+    suiteSequence = [ simplePathFilter,+                      onlyTagsFilter,+                      pathTagsFilter,+                      suiteAllFilter,+                      suitePathFilter,+                      suiteTagsFilter,+                      suitePathTagsFilter ]+  in+  [("empty", "", []),+   ("space", "  ", []),+   ("tab", "\t", []),+   ("newline", "\n", []),+   ("comment", "# Outer@tag", []),+   ("comment_comment", "# Outer@tag # hello", []),+   ("comment_newline_comment", "# Outer@tag\n# hello", []),+   ("space_comment", " # Outer@tag", []),+   ("tab_comment", "\t# Outer@tag", []),+   ("newline_comment", "\n# [Suite]", []),+   ("newline_space_comment", "\n # [Suite]", []),+   ("newline_tab_comment", "\n\t# [Suite]", []),+   ("comment_newline", "# Outer@tag\n", []),+   ("comment_newline_space", "# Outer@tag\n ", []),+   ("comment_newline_tab", "# Outer@tag\n\t", []),+   ("space_comment_newline", " # Outer@tag\n", []),+   ("space_comment_newline_space", " # Outer@tag\n ", []),+   ("space_comment_newline_tab", " # Outer@tag\n\t", []),+   ("tab_comment_newline", "\t# Outer@tag\n", []),+   ("tab_comment_newline_space", "\t# Outer@tag\n ", []),+   ("tab_comment_newline_tab", "\t# Outer@tag\n\t", []),+   ("suiteAll", suiteFilterStr, [suiteAllFilter]),+   ("space_suiteAll", " " ++ suiteFilterStr, [suiteAllFilter]),+   ("tab_suiteAll", "\t" ++ suiteFilterStr, [suiteAllFilter]),+   ("newline_suiteAll", "\n" ++ suiteFilterStr, [suiteAllFilter]),+   ("comment_suiteAll", "# comment\n" ++ suiteFilterStr, [suiteAllFilter]),+   ("suiteAll_space", suiteFilterStr ++ " ", [suiteAllFilter]),+   ("suiteAll_tab", suiteFilterStr ++ "\t", [suiteAllFilter]),+   ("suiteAll_newline", suiteFilterStr ++ "\n", [suiteAllFilter]),+   ("suiteAll_comment", suiteFilterStr ++ "# comment\n", [suiteAllFilter]),+   ("suiteAll_newline_suiteAll",+    suiteFilterStr ++ "\n" ++ suiteFilterStr,+    [suiteAllFilter, suiteAllFilter]),+   ("suiteAll_comment_suiteAll",+    suiteFilterStr ++ "# comment\n" ++ suiteFilterStr,+    [suiteAllFilter, suiteAllFilter]),+   ("simplePath", simplePathStr, [simplePathFilter]),+   ("space_simplePath", " " ++ simplePathStr, [simplePathFilter]),+   ("tab_simplePath", "\t" ++ simplePathStr, [simplePathFilter]),+   ("newline_simplePath", "\n" ++ simplePathStr, [simplePathFilter]),+   ("comment_simplePath", "# comment\n" ++ simplePathStr, [simplePathFilter]),+   ("simplePath_space", simplePathStr ++ " ", [simplePathFilter]),+   ("simplePath_tab", simplePathStr ++ "\t", [simplePathFilter]),+   ("simplePath_newline", simplePathStr ++ "\n", [simplePathFilter]),+   ("simplePath_comment", simplePathStr ++ "# comment\n", [simplePathFilter]),+   ("simplePath_newline_simplePath",+    simplePathStr ++ "\n" ++ simplePathStr,+    [simplePathFilter, simplePathFilter]),+   ("simplePath_comment_simplePath",+    simplePathStr ++ "# comment\n" ++ simplePathStr,+    [simplePathFilter, simplePathFilter]),+   ("suitePath", suitePathStr, [suitePathFilter]),+   ("space_suitePath", " " ++ suitePathStr, [suitePathFilter]),+   ("tab_suitePath", "\t" ++ suitePathStr, [suitePathFilter]),+   ("newline_suitePath", "\n" ++ suitePathStr, [suitePathFilter]),+   ("comment_suitePath", "# comment\n" ++ suitePathStr, [suitePathFilter]),+   ("suitePath_space", suitePathStr ++ " ", [suitePathFilter]),+   ("suitePath_tab", suitePathStr ++ "\t", [suitePathFilter]),+   ("suitePath_newline", suitePathStr ++ "\n", [suitePathFilter]),+   ("suitePath_comment", suitePathStr ++ "# comment\n", [suitePathFilter]),+   ("suitePath_newline_suitePath",+    suitePathStr ++ "\n" ++ suitePathStr,+    [suitePathFilter, suitePathFilter]),+   ("suitePath_comment_suitePath",+    suitePathStr ++ "# comment\n" ++ suitePathStr,+    [suitePathFilter, suitePathFilter]),+   ("onlyTags", onlyTagsStr, [onlyTagsFilter]),+   ("space_onlyTags", " " ++ onlyTagsStr, [onlyTagsFilter]),+   ("tab_onlyTags", "\t" ++ onlyTagsStr, [onlyTagsFilter]),+   ("newline_onlyTags", "\n" ++ onlyTagsStr, [onlyTagsFilter]),+   ("comment_onlyTags", "# comment\n" ++ onlyTagsStr, [onlyTagsFilter]),+   ("onlyTags_space", onlyTagsStr ++ " ", [onlyTagsFilter]),+   ("onlyTags_tab", onlyTagsStr ++ "\t", [onlyTagsFilter]),+   ("onlyTags_newline", onlyTagsStr ++ "\n", [onlyTagsFilter]),+   ("onlyTags_comment", onlyTagsStr ++ "# comment\n", [onlyTagsFilter]),+   ("onlyTags_newline_onlyTags",+    onlyTagsStr ++ "\n" ++ onlyTagsStr,+    [onlyTagsFilter, onlyTagsFilter]),+   ("onlyTags_comment_onlyTags",+    onlyTagsStr ++ "# comment\n" ++ onlyTagsStr,+    [onlyTagsFilter, onlyTagsFilter]),+   ("suiteTags", suiteTagsStr, [suiteTagsFilter]),+   ("space_suiteTags", " " ++ suiteTagsStr, [suiteTagsFilter]),+   ("tab_suiteTags", "\t" ++ suiteTagsStr, [suiteTagsFilter]),+   ("newline_suiteTags", "\n" ++ suiteTagsStr, [suiteTagsFilter]),+   ("comment_suiteTags", "# comment\n" ++ suiteTagsStr, [suiteTagsFilter]),+   ("suiteTags_space", suiteTagsStr ++ " ", [suiteTagsFilter]),+   ("suiteTags_tab", suiteTagsStr ++ "\t", [suiteTagsFilter]),+   ("suiteTags_newline", suiteTagsStr ++ "\n", [suiteTagsFilter]),+   ("suiteTags_comment", suiteTagsStr ++ "# comment\n", [suiteTagsFilter]),+   ("suiteTags_newline_suiteTags",+    suiteTagsStr ++ "\n" ++ suiteTagsStr,+    [suiteTagsFilter, suiteTagsFilter]),+   ("suiteTags_comment_suiteTags",+    suiteTagsStr ++ "# comment\n" ++ suiteTagsStr,+    [suiteTagsFilter, suiteTagsFilter]),+   ("pathTags", pathTagsStr, [pathTagsFilter]),+   ("space_pathTags", " " ++ pathTagsStr, [pathTagsFilter]),+   ("tab_pathTags", "\t" ++ pathTagsStr, [pathTagsFilter]),+   ("newline_pathTags", "\n" ++ pathTagsStr, [pathTagsFilter]),+   ("comment_pathTags", "# comment\n" ++ pathTagsStr, [pathTagsFilter]),+   ("pathTags_space", pathTagsStr ++ " ", [pathTagsFilter]),+   ("pathTags_tab", pathTagsStr ++ "\t", [pathTagsFilter]),+   ("pathTags_newline", pathTagsStr ++ "\n", [pathTagsFilter]),+   ("pathTags_comment", pathTagsStr ++ "# comment\n", [pathTagsFilter]),+   ("pathTags_newline_pathTags",+    pathTagsStr ++ "\n" ++ pathTagsStr,+    [pathTagsFilter, pathTagsFilter]),+   ("pathTags_comment_pathTags",+    pathTagsStr ++ "# comment\n" ++ pathTagsStr,+    [pathTagsFilter, pathTagsFilter]),+   ("suitePathTags", suitePathTagsStr, [suitePathTagsFilter]),+   ("space_suitePathTags", " " ++ suitePathTagsStr, [suitePathTagsFilter]),+   ("tab_suitePathTags", "\t" ++ suitePathTagsStr, [suitePathTagsFilter]),+   ("newline_suitePathTags", "\n" ++ suitePathTagsStr, [suitePathTagsFilter]),+   ("comment_suitePathTags", "# comment\n" ++ suitePathTagsStr,+    [suitePathTagsFilter]),+   ("suitePathTags_space", suitePathTagsStr ++ " ", [suitePathTagsFilter]),+   ("suitePathTags_tab", suitePathTagsStr ++ "\t", [suitePathTagsFilter]),+   ("suitePathTags_newline", suitePathTagsStr ++ "\n", [suitePathTagsFilter]),+   ("suitePathTags_comment", suitePathTagsStr ++ "# comment\n",+    [suitePathTagsFilter]),+   ("suitePathTags_newline_suitePathTags",+    suitePathTagsStr ++ "\n" ++ suitePathTagsStr,+    [suitePathTagsFilter, suitePathTagsFilter]),+   ("suitePathTags_comment_suitePathTags",+    suitePathTagsStr ++ "# comment\n" ++ suitePathTagsStr,+    [suitePathTagsFilter, suitePathTagsFilter]),+   ("sequence", intercalate "\n" suiteSequenceStrs, suiteSequence),+   ("commented_sequence", intercalate "# comment \n" suiteSequenceStrs,+    suiteSequence),+   ("indented_sequence", concat (map (++ "\n  ") suiteSequenceStrs),+    suiteSequence)+  ]++fileParserTests =+  map (\(name, content, expected) -> makeFileParserTest name content expected)+      fileTests++innerPath :: Selector -> Selector+innerPath inner = Selector { selectorInners = HashMap.singleton "Inner" inner,+                             selectorTags = Nothing }++outerPath :: Selector -> Selector+outerPath inner = Selector { selectorInners = HashMap.singleton "Outer" inner,+                             selectorTags = Nothing }++outerInnerPath :: Selector -> Selector+outerInnerPath = outerPath . innerPath++outerAndInnerPath :: Selector+outerAndInnerPath =+  Selector { selectorInners = HashMap.fromList [("Outer", allSelector),+                                            ("Inner", allSelector)],+             selectorTags = Nothing }++outerInnerAndInnerPath :: Selector+outerInnerAndInnerPath =+  Selector { selectorInners = HashMap.fromList [("Outer", innerPath allSelector),+                                            ("Inner", allSelector)],+             selectorTags = Nothing }++tag1OuterAndInnerPath :: Selector+tag1OuterAndInnerPath =+  Selector { selectorInners = HashMap.fromList [("Outer", allSelector),+                                            ("Inner", allSelector)],+             selectorTags = Just $! HashSet.singleton "tag1" }++tag1 :: Selector -> Selector+tag1 inner = inner { selectorTags = Just $! HashSet.singleton "tag1" }++tag2 :: Selector -> Selector+tag2 inner = inner { selectorTags = Just $! HashSet.singleton "tag2" }++tag12 :: Selector -> Selector+tag12 inner = inner { selectorTags = Just $! HashSet.fromList ["tag1", "tag2"] }+++combineSelectorTestCases :: [(String, Selector, Selector, Selector)]+combineSelectorTestCases =+  [("all_all", allSelector, allSelector, allSelector),+   ("all_Outer", allSelector, outerPath allSelector, allSelector),+   ("Outer_all", outerPath allSelector, allSelector, allSelector),+   ("all__Outer_Inner", allSelector, outerInnerPath allSelector, allSelector),+   ("Outer_Inner__all", outerInnerPath allSelector, allSelector, allSelector),+   ("Outer_Outer", outerPath allSelector, outerPath allSelector,+    outerPath allSelector),+   ("Outer_Inner", outerPath allSelector, innerPath allSelector,+    outerAndInnerPath),+   ("Inner_Outer", innerPath allSelector, outerPath allSelector,+    outerAndInnerPath),+   ("Outer__Outer_Inner", outerPath allSelector, outerInnerPath allSelector,+    outerPath allSelector),+   ("Outer_Inner__Outer", outerInnerPath allSelector, outerPath allSelector,+    outerPath allSelector),+   ("Inner__Outer_Inner", innerPath allSelector, outerInnerPath allSelector,+    outerInnerAndInnerPath),+   ("Outer_Inner__Inner", outerInnerPath allSelector, innerPath allSelector,+    outerInnerAndInnerPath),+   ("tag1_Outer", tag1 allSelector, outerPath allSelector,+    tag1 (outerPath allSelector)),+   ("Outer_tag1", outerPath allSelector, tag1 allSelector,+    tag1 (outerPath allSelector)),+   ("tag1__Outer_Inner", tag1 allSelector, outerInnerPath allSelector,+    tag1 (outerInnerPath allSelector)),+   ("Outer_Inner__tag1", outerInnerPath allSelector, tag1 allSelector,+    tag1 (outerInnerPath allSelector)),+   ("tag1_Outer__Outer", tag1 (outerPath allSelector), outerPath allSelector,+    tag1 (outerPath allSelector)),+   ("Outer__tag1_Outer", outerPath allSelector, tag1 (outerPath allSelector),+    tag1 (outerPath allSelector)),+   ("tag1_Inner__Outer", tag1 (innerPath allSelector), outerPath allSelector,+    tag1OuterAndInnerPath),+   ("Outer__tag1_Inner", outerPath allSelector, tag1 (innerPath allSelector),+    tag1OuterAndInnerPath),+   ("tag1_Outer__tag1_Inner", tag1 (innerPath allSelector),+    tag1 (outerPath allSelector),+    tag1 outerAndInnerPath),+   ("tag1_Inner__tag1_Outer", tag1 (outerPath allSelector),+    tag1 (innerPath allSelector),+    tag1 outerAndInnerPath),+   ("all_tag1", allSelector, tag1 allSelector, allSelector),+   ("tag1_all", tag1 allSelector, allSelector, allSelector),+   ("all_tag2", allSelector, tag2 allSelector, allSelector),+   ("tag2_all", tag2 allSelector, allSelector, allSelector),+   ("all_tag12", allSelector, tag12 allSelector, allSelector),+   ("tag12_all", tag12 allSelector, allSelector, allSelector),+   ("tag1_tag1", tag1 allSelector, tag1 allSelector, tag1 allSelector),+   ("tag1_tag2", tag1 allSelector, tag2 allSelector, tag12 allSelector),+   ("tag2_tag1", tag2 allSelector, tag1 allSelector, tag12 allSelector),+   ("tag1_tag12", tag1 allSelector, tag12 allSelector, tag12 allSelector),+   ("tag12_tag1", tag12 allSelector, tag1 allSelector, tag12 allSelector),+   ("tag1_tag2", tag1 allSelector, tag2 allSelector, tag12 allSelector),+   ("tag2_tag1", tag2 allSelector, tag1 allSelector, tag12 allSelector),+   ("tag2_tag2", tag2 allSelector, tag2 allSelector, tag2 allSelector),+   ("tag2_tag12", tag2 allSelector, tag12 allSelector, tag12 allSelector),+   ("tag12_tag2", tag12 allSelector, tag2 allSelector, tag12 allSelector),+   ("tag12_tag1", tag12 allSelector, tag1 allSelector, tag12 allSelector),+   ("tag1_tag12", tag1 allSelector, tag12 allSelector, tag12 allSelector),+   ("tag12_tag2", tag12 allSelector, tag2 allSelector, tag12 allSelector),+   ("tag2_tag12", tag2 allSelector, tag12 allSelector, tag12 allSelector),+   ("tag12_tag12", tag12 allSelector, tag12 allSelector, tag12 allSelector),+   ("Outer_tag1__Outer", outerPath (tag1 allSelector), outerPath allSelector,+    outerPath allSelector),+   ("Outer__Outer_tag1", outerPath allSelector, outerPath (tag1 allSelector),+    outerPath allSelector),+   ("Outer_tag1__Outer_tag1", outerPath (tag1 allSelector),+    outerPath (tag1 allSelector), outerPath (tag1 allSelector)),+   ("Outer_tag1__Outer_tag2", outerPath (tag1 allSelector),+    outerPath (tag2 allSelector), outerPath (tag12 allSelector)),+   ("Outer_tag2__Outer_tag1", outerPath (tag2 allSelector),+    outerPath (tag1 allSelector), outerPath (tag12 allSelector)),+   ("Outer_Inner_tag1__Outer_tag1", outerInnerPath (tag1 allSelector),+    outerPath (tag1 allSelector), outerPath (tag1 allSelector)),+   ("Outer_tag1__Outer_Inner_tag1", outerPath (tag1 allSelector),+    outerInnerPath (tag1 allSelector), outerPath (tag1 allSelector)),+   ("tag1_Outer__Outer_tag1", tag1 (outerPath allSelector),+    outerPath (tag1 allSelector), tag1 (outerPath allSelector)),+   ("Outer_tag1__tag1_Outer", outerPath (tag1 allSelector),+    tag1 (outerPath allSelector), tag1 (outerPath allSelector))+  ]++combineSelectorTests :: [Test]+combineSelectorTests =+  let+    makeTest :: (String, Selector, Selector, Selector) -> Test+    makeTest (name, input1, input2, expected) =+      let+        runTest =+          let+            actual = combineSelectors input1 input2+          in do+            if actual == expected+              then return (Finished Pass)+              else return (Finished (Fail ("Combining\n" ++ show input1 +++                                           "\nwith\n" ++ show input2 +++                                           "\nexpected\n" ++ show expected +++                                           "\ngot\n" ++ show actual)))++        testInstance = TestInstance { name = name, tags = [], options = [],+                                      setOption = (\_ _ -> return testInstance),+                                      run = runTest }+      in+        Test testInstance+  in+    map makeTest combineSelectorTestCases++onePath :: Selector+onePath = Selector { selectorInners = HashMap.singleton "One" allSelector,+                     selectorTags = Nothing }++twoPath :: Selector+twoPath = Selector { selectorInners = HashMap.singleton "Two" allSelector,+                     selectorTags = Nothing }++oneTwoPath :: Selector+oneTwoPath = Selector { selectorInners = HashMap.fromList [("One", allSelector),+                                                       ("Two", allSelector)],+                        selectorTags = Nothing }++emptyOneFilter :: Filter+emptyOneFilter = Filter { filterSuites = HashSet.empty,+                          filterOptions = HashMap.empty,+                          filterSelector = HashSet.singleton onePath }++emptyTwoFilter :: Filter+emptyTwoFilter = Filter { filterSuites = HashSet.empty,+                          filterOptions = HashMap.empty,+                          filterSelector = HashSet.singleton twoPath }++emptyOneTwoFilter :: Filter+emptyOneTwoFilter = Filter { filterSuites = HashSet.empty,+                             filterOptions = HashMap.empty,+                             filterSelector = HashSet.singleton oneTwoPath }++allAFilter :: Filter+allAFilter = Filter { filterSuites = HashSet.singleton "A",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton allSelector }++oneAFilter :: Filter+oneAFilter = Filter { filterSuites = HashSet.singleton "A",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton onePath }++oneBFilter :: Filter+oneBFilter = Filter { filterSuites = HashSet.singleton "B",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton onePath }++oneABFilter :: Filter+oneABFilter = Filter { filterSuites = HashSet.fromList ["A", "B"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton onePath }++oneACFilter :: Filter+oneACFilter = Filter { filterSuites = HashSet.fromList ["A", "C"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton onePath }++twoAFilter :: Filter+twoAFilter = Filter { filterSuites = HashSet.singleton "A",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton twoPath }++twoBFilter :: Filter+twoBFilter = Filter { filterSuites = HashSet.singleton "B",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton twoPath }++twoABFilter :: Filter+twoABFilter = Filter { filterSuites = HashSet.fromList ["A", "B"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton twoPath }++twoACFilter :: Filter+twoACFilter = Filter { filterSuites = HashSet.fromList ["A", "C"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton twoPath }++oneTwoAFilter :: Filter+oneTwoAFilter = Filter { filterSuites = HashSet.singleton "A",+                         filterOptions = HashMap.empty,+                         filterSelector = HashSet.singleton oneTwoPath }++oneTwoBFilter :: Filter+oneTwoBFilter = Filter { filterSuites = HashSet.singleton "B",+                         filterOptions = HashMap.empty,+                         filterSelector = HashSet.singleton oneTwoPath }++oneTwoABFilter :: Filter+oneTwoABFilter = Filter { filterSuites = HashSet.fromList ["A", "B"],+                          filterOptions = HashMap.empty,+                          filterSelector = HashSet.singleton oneTwoPath }++oneTwoACFilter :: Filter+oneTwoACFilter = Filter { filterSuites = HashSet.fromList ["A", "C"],+                          filterOptions = HashMap.empty,+                          filterSelector = HashSet.singleton oneTwoPath }++allBFilter :: Filter+allBFilter = Filter { filterSuites = HashSet.singleton "B",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton allSelector }++allCFilter :: Filter+allCFilter = Filter { filterSuites = HashSet.singleton "C",+                      filterOptions = HashMap.empty,+                      filterSelector = HashSet.singleton allSelector }++allABFilter :: Filter+allABFilter = Filter { filterSuites = HashSet.fromList ["A", "B"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton allSelector }++allACFilter :: Filter+allACFilter = Filter { filterSuites = HashSet.fromList ["A", "C"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton allSelector }++allBCFilter :: Filter+allBCFilter = Filter { filterSuites = HashSet.fromList ["B", "C"],+                       filterOptions = HashMap.empty,+                       filterSelector = HashSet.singleton allSelector }+++filterTestCases :: [(String, [String], [Filter],+                     [(Strict.Text, HashMap OptionMap Selector)])]+filterTestCases = [+    ("A_nil", ["A"], [],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_nil", ["A", "B"], [],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_nil", ["A", "B", "C"], [],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty allSelector)]),+    ("A_emptyOne", ["A"], [emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("AB_emptyOne", ["A", "B"], [emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_emptyOne", ["A", "B", "C"], [emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("A_emptyOne_emptyTwo", ["A"], [emptyOneFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_emptyOne_emptyTwo", ["A", "B"], [emptyOneFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_emptyOne_emptyTwo", ["A", "B", "C"], [emptyOneFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_emptyOne_emptyOneTwo", ["A"], [emptyOneFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_emptyOne_emptyOneTwo", ["A", "B"], [emptyOneFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_emptyOne_emptyOneTwo", ["A", "B", "C"], [emptyOneFilter,+                                                   emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_allA", ["A"], [allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("A_OneA", ["A"], [oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("A_OneA_OneA", ["A"], [oneAFilter, oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("A_OneA_TwoA", ["A"], [oneAFilter, twoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_OneA_OneTwoA", ["A"], [oneAFilter, oneTwoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_OneA_allA", ["A"], [oneAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("A_allA_allA", ["A"], [allAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("A_OneA_emptyOne", ["A"], [oneAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("A_TwoA_emptyOne", ["A"], [twoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_OneTwoA_emptyOne", ["A"], [oneTwoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_allA_emptyOne", ["A"], [allAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("A_OneA_emptyTwo", ["A"], [oneAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_TwoA_emptyTwo", ["A"], [twoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty twoPath)]),+    ("A_OneTwoA_emptyTwo", ["A"], [oneTwoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_allA_emptyTwo", ["A"], [allAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("A_OneA_emptyOneTwo", ["A"], [oneAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_TwoA_emptyOneTwo", ["A"], [twoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_OneTwoA_emptyOneTwo", ["A"], [oneTwoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("A_allA_emptyOneTwo", ["A"], [allAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_allA", ["A", "B"], [allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_OneA", ["A", "B"], [oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneA_OneA", ["A", "B"], [oneAFilter, oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneA_TwoA", ["A", "B"], [oneAFilter, twoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_OneA_OneTwoA", ["A", "B"], [oneAFilter, oneTwoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_OneA_allA", ["A", "B"], [oneAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_allA_allA", ["A", "B"], [allAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_OneA_OneB", ["A", "B"], [oneAFilter, oneBFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_allA_OneB", ["A", "B"], [allAFilter, oneBFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneA_allB", ["A", "B"], [oneAFilter, allBFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_allA_allB", ["A", "B"], [allAFilter, allBFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_OneA_OneAB", ["A", "B"], [oneAFilter, oneABFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneA_TwoAB", ["A", "B"], [oneAFilter, twoABFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_OneA_OneTwoAB", ["A", "B"], [oneAFilter, oneTwoABFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_allA_OneAB", ["A", "B"], [allAFilter, oneABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_allA_TwoAB", ["A", "B"], [allAFilter, twoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_allA_OneTwoAB", ["A", "B"], [allAFilter, oneTwoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_OneA_allAB", ["A", "B"], [oneAFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_allA_allAB", ["A", "B"], [allAFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("AB_OneA_emptyOne", ["A", "B"], [oneAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_TwoA_emptyOne", ["A", "B"], [twoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneTwoA_emptyOne", ["A", "B"], [oneTwoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_allA_emptyOne", ["A", "B"], [allAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("AB_OneA_emptyTwo", ["A", "B"], [oneAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_TwoA_emptyTwo", ["A", "B"], [twoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty twoPath),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_OneTwoA_emptyTwo", ["A", "B"], [oneTwoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_allA_emptyTwo", ["A", "B"], [allAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("AB_OneA_emptyOneTwo", ["A", "B"], [oneAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_TwoA_emptyOneTwo", ["A", "B"], [twoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_OneTwoA_emptyOneTwo", ["A", "B"], [oneTwoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("AB_allA_emptyOneTwo", ["A", "B"], [allAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_allA", ["A", "B", "C"], [allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA", ["A", "B", "C"], [oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_OneA", ["A", "B", "C"], [oneAFilter, oneAFilter],+     [("A", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_TwoA", ["A", "B", "C"], [oneAFilter, twoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneA_OneTwoA", ["A", "B", "C"], [oneAFilter, oneTwoAFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneA_allA", ["A", "B", "C"], [oneAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_allA_allA", ["A", "B", "C"], [allAFilter, allAFilter],+     [("A", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA_OneB", ["A", "B", "C"], [oneAFilter, oneBFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_allA_OneB", ["A", "B", "C"], [allAFilter, oneBFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_allB", ["A", "B", "C"], [oneAFilter, allBFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_allA_allB", ["A", "B", "C"], [allAFilter, allBFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA_OneAB", ["A", "B", "C"], [oneAFilter, oneABFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_TwoAB", ["A", "B", "C"], [oneAFilter, twoABFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneA_OneTwoAB", ["A", "B", "C"], [oneAFilter, oneTwoABFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneA_OneAC", ["A", "B", "C"], [oneAFilter, oneACFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_TwoAC", ["A", "B", "C"], [oneAFilter, twoACFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneA_OneTwoAC", ["A", "B", "C"], [oneAFilter, oneTwoACFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneAB_OneAC", ["A", "B", "C"], [oneABFilter, oneACFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneAB_TwoAC", ["A", "B", "C"], [oneABFilter, twoACFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneAB_OneTwoAC", ["A", "B", "C"], [oneABFilter, oneTwoACFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_allA_OneAB", ["A", "B", "C"], [allAFilter, oneABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_allA_TwoAB", ["A", "B", "C"], [allAFilter, twoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_allA_OneTwoAB", ["A", "B", "C"], [allAFilter, oneTwoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_allAC_OneAB", ["A", "B", "C"], [allACFilter, oneABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_allAC_TwoAB", ["A", "B", "C"], [allACFilter, twoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_allAC_OneTwoAB", ["A", "B", "C"], [allACFilter, oneTwoABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA_allAB", ["A", "B", "C"], [oneAFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_allA_allAB", ["A", "B", "C"], [allAFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA_allAB", ["A", "B", "C"], [oneACFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_allA_allAB", ["A", "B", "C"], [allACFilter, allABFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty allSelector)]),+    ("ABC_OneA_emptyOne", ["A", "B", "C"], [oneAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_TwoA_emptyOne", ["A", "B", "C"], [twoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneTwoA_emptyOne", ["A", "B", "C"], [oneTwoAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_allA_emptyOne", ["A", "B", "C"], [allAFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneAB_emptyOne", ["A", "B", "C"], [oneABFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty onePath),+      ("B", HashMap.singleton HashMap.empty onePath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_TwoAB_emptyOne", ["A", "B", "C"], [twoABFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneTwoAB_emptyOne", ["A", "B", "C"], [oneTwoABFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_allAB_emptyOne", ["A", "B", "C"], [allABFilter, emptyOneFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty onePath)]),+    ("ABC_OneA_emptyTwo", ["A", "B", "C"], [oneAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_TwoA_emptyTwo", ["A", "B", "C"], [twoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty twoPath),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneTwoA_emptyTwo", ["A", "B", "C"], [oneTwoAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_allA_emptyTwo", ["A", "B", "C"], [allAFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneAB_emptyTwo", ["A", "B", "C"], [oneABFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_TwoAB_emptyTwo", ["A", "B", "C"], [twoABFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty twoPath),+      ("B", HashMap.singleton HashMap.empty twoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneTwoAB_emptyTwo", ["A", "B", "C"], [oneTwoABFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_allAB_emptyTwo", ["A", "B", "C"], [allABFilter, emptyTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty twoPath)]),+    ("ABC_OneA_emptyOneTwo", ["A", "B", "C"], [oneAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_TwoA_emptyOneTwo", ["A", "B", "C"], [twoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneTwoA_emptyOneTwo", ["A", "B", "C"],+     [oneTwoAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_allA_emptyOneTwo", ["A", "B", "C"], [allAFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneAB_emptyOneTwo", ["A", "B", "C"], [oneABFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_TwoAB_emptyOneTwo", ["A", "B", "C"], [twoABFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_OneTwoAB_emptyOneTwo", ["A", "B", "C"],+     [oneTwoABFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty oneTwoPath),+      ("B", HashMap.singleton HashMap.empty oneTwoPath),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)]),+    ("ABC_allAB_emptyOneTwo", ["A", "B", "C"], [allABFilter, emptyOneTwoFilter],+     [("A", HashMap.singleton HashMap.empty allSelector),+      ("B", HashMap.singleton HashMap.empty allSelector),+      ("C", HashMap.singleton HashMap.empty oneTwoPath)])+  ]++filterTests :: [Test]+filterTests =+  let+    makeTest :: (String, [String], [Filter],+                 [(Strict.Text, HashMap OptionMap Selector)])+             -> Test+    makeTest (name, suites, filters, expected) =+      let+        runTest =+          let+            actual = HashMap.toList (suiteSelectors (map Strict.pack suites)+                                                    filters)+          in do+            if actual == expected+              then return (Finished Pass)+              else return (Finished (Fail ("Combining\n" ++ show filters +++                                           "\nwith suites\n" ++ show suites +++                                           "\nexpected\n" ++ show expected +++                                           "\ngot\n" ++ show actual)))++        testInstance = TestInstance { name = name, tags = [], options = [],+                                      setOption = (\_ _ -> return testInstance),+                                      run = runTest }+      in+        Test testInstance+  in+    map makeTest filterTestCases+++testlist = [ testGroup "fileParser" fileParserTests,+             testGroup "filterParse" filterParseTests,+             testGroup "combineSelectors" combineSelectorTests,+             testGroup "suiteSelectors" filterTests ]++tests :: Test+tests = testGroup "Filter" testlist

@@ -0,0 +1,211 @@+{-# LANGUAGE OverloadedStrings #-}++module Tests.Test.HUnitPlus.Main where++import Data.List+import Distribution.TestSuite+import System.Directory+import Test.HUnitPlus.Main+import Test.HUnitPlus.Base+import qualified Data.Text as Strict++makeMainTest :: (String, IO (), IO (), Bool, [TestSuite], Opts) -> Test+makeMainTest (name, setup, cleanup, shouldPass, suites, opts) =+  let+    runTest =+      do+        setup+        out <- topLevel suites opts+        cleanup+        case out of+          Left msgs ->+            if not shouldPass+              then return (Finished Pass)+              else return (Finished (Fail ("Expected test to pass, " +++                                           "but failed with\n" +++                                           intercalate "\n" (map Strict.unpack msgs))))+          Right _ ->+            if shouldPass+              then return (Finished Pass)+              else return (Finished (Fail "Expected test to fail"))+    testInstance = TestInstance { name = name, tags = [], options = [],+                                  setOption = (\_ _ -> return testInstance),+                                  run = runTest }+  in+    Test testInstance++makeTestDir :: IO ()+makeTestDir = createDirectory "TestDir"++delTestDir :: IO ()+delTestDir = removeDirectory "TestDir"++delXMLReport :: IO ()+delXMLReport = removeFile "TestDir/report.xml" >> delTestDir++delTxtReport :: IO ()+delTxtReport = removeFile "TestDir/report.txt" >> delTestDir++delTxtXMLReport :: IO ()+delTxtXMLReport = removeFile "TestDir/report.xml" >>+                  removeFile "TestDir/report.txt" >>+                  delTestDir++quietOpts = opts { consmode = [Quiet] }++filterOpts = [ (False, False), (True, False), (False, True), (True, True) ]++makeSuiteData suitename =+  map (\filters -> (TestSuite { suiteName = "suitename",+                                suiteConcurrently = False,+                                suiteOptions = [],+                                suiteTests = suiteTestList },+                    filters))filterOpts++suiteCombos =+  foldl (\accum suite1case ->+          (foldl (\accum suite2case -> [suite1case, suite2case] : accum)+                 accum (makeSuiteData "Suite2")))+        [] (makeSuiteData "Suite1")++suitePairCombos = foldl (\accum a ->+                          foldl (\accum b -> (a, b) : accum)+                                accum suiteCombos)+                        [] suiteCombos++makeFilter :: String -> (Bool, Bool) -> [String]+makeFilter suitename (False, False) = []+makeFilter suitename (True, False) = ["[" ++ suitename ++ "]Pass"]+makeFilter suitename (False, True) = ["[" ++ suitename ++ "]Fail"]+makeFilter suitename (True, True) = ["[" ++ suitename ++ "]Pass",+                                     "[" ++ suitename ++ "]Fail"]++makeFilters suitedata =+  foldl (\accum (TestSuite { suiteName = suitename }, filters) ->+          makeFilter (Strict.unpack suitename) filters ++ accum) [] suitedata++shouldPass suitedata = not (all (\(_, (a, b)) -> not a && not b) suitedata) ||+                       not (any (\(_, (_, fail)) -> fail) suitedata)++suiteTestList = [ "Pass" ~: assertSuccess, "Fail" ~: assertFailure "Fail" ]++makeName suitedata =+  intercalate "__"+    (foldl (\accum (TestSuite { suiteName = name }, (pass, fail)) ->+             (Strict.unpack name ++ "_" ++ show pass ++ "_" ++ show fail) : accum)+           [] suitedata)++makeCmdOptTest suitedata =+  ("cmdopt___" ++ makeName suitedata, return (), return (), shouldPass suitedata,+   map fst suitedata, quietOpts { filters = makeFilters suitedata })++makeTestlistTest suitedata =+  let+    createFilterFile =+      do+        createDirectory "TestDir"+        writeFile "TestDir/testlist" (intercalate "\n" (makeFilters suitedata))++    delFilterFile = removeFile "TestDir/testlist" >> delTestDir+  in+    ("testlist___" ++ makeName suitedata, createFilterFile, delFilterFile,+     shouldPass suitedata, map fst suitedata,+     quietOpts { testlist = ["TestDir/testlist"] })++makeCmdOptTestlistTest (cmdoptdata, testlistdata) =+  let+    createFilterFile =+      do+        createDirectory "TestDir"+        writeFile "TestDir/testlist"+                  (intercalate "\n" (makeFilters testlistdata))++    delFilterFile = removeFile "TestDir/testlist" >> delTestDir+  in+    ("cmdopt_testlist____" ++ makeName cmdoptdata ++ "___" +++     makeName testlistdata, createFilterFile, delFilterFile,+     shouldPass cmdoptdata && shouldPass testlistdata, map fst cmdoptdata,+     quietOpts { testlist = ["TestDir/testlist"],+                 filters = makeFilters cmdoptdata })++makeDualTestlistTest (suitedata1, suitedata2) =+  let+    createFilterFile =+      do+        createDirectory "TestDir"+        writeFile "TestDir/testlist1" (intercalate "\n" (makeFilters suitedata1))+        writeFile "TestDir/testlist2" (intercalate "\n" (makeFilters suitedata2))++    delFilterFile =+      do+        removeFile "TestDir/testlist1"+        removeFile "TestDir/testlist2"+        delTestDir+  in+    ("dual_testlist____" ++ makeName suitedata1 ++ "___" ++ makeName suitedata2,+     createFilterFile, delFilterFile,+     shouldPass suitedata1 && shouldPass suitedata2, [],+     quietOpts { testlist = ["TestDir/testlist1", "TestDir/testlist2"] })++mainTests = [+    ("multiple_console_mode", return (), return (), False, [],+     opts { consmode = [Quiet, Terminal] }),+    ("multiple_xml_report", return (), return (), False, [],+     opts { xmlreport = ["report1.xml", "report2.xml"] }),+    ("multiple_txt_report", return (), return (), False, [],+     opts { txtreport = ["report1.txt", "report2.txt"] }),+    ("multiple_xml_txt_report", return (), return (), False, [],+     opts { xmlreport = ["report1.xml", "report2.xml"],+            txtreport = ["report1.txt", "report2.txt"] }),+    ("nonexistent_xml_report", makeTestDir, delTestDir, False, [],+     opts { xmlreport = ["TestDir/nonexistent/report.xml"] }),+    ("nonexistent_txt_report", makeTestDir, delTestDir, False, [],+     opts { txtreport = ["TestDir/nonexistent/report.txt"] }),+    ("nonexistent_txt_xml_report", makeTestDir, delTestDir, False, [],+     opts { txtreport = ["TestDir/nonexistent/report.txt"],+            xmlreport = ["TestDir/nonexistent/report.xml"] }),+    ("nonexistent_testlist", makeTestDir, delTestDir, False, [],+     opts { xmlreport = ["TestDir/nonexistent/testlist"] }),+    ("run_quiet_no_xml_no_txt", return (), return (), True, [], quietOpts),+    ("run_terminal_no_xml_no_txt", return (), return (), True, [],+     opts { consmode = [Terminal] }),+    ("run_text_no_xml_no_txt", return (), return (), True, [],+     opts { consmode = [Text] }),+    ("run_verbose_no_xml_no_txt", return (), return (), True, [],+     opts { consmode = [Verbose] }),+    ("run_quiet_xml_no_txt", makeTestDir, delXMLReport, True, [],+     opts { consmode = [Quiet], xmlreport = ["TestDir/report.xml"] }),+    ("run_terminal_xml_no_txt", makeTestDir, delXMLReport, True, [],+     opts { consmode = [Terminal], xmlreport = ["TestDir/report.xml"] }),+    ("run_text_xml_no_txt", makeTestDir, delXMLReport, True, [],+     opts { consmode = [Text], xmlreport = ["TestDir/report.xml"] }),+    ("run_verbose_xml_no_txt", makeTestDir, delXMLReport, True, [],+     opts { consmode = [Verbose], xmlreport = ["TestDir/report.xml"] }),+    ("run_quiet_no_xml_txt", makeTestDir, delTxtReport, True, [],+     opts { consmode = [Quiet], txtreport = ["TestDir/report.txt"] }),+    ("run_terminal_no_xml_txt", makeTestDir, delTxtReport, True, [],+     opts { consmode = [Terminal], txtreport = ["TestDir/report.txt"] }),+    ("run_text_no_xml_txt", makeTestDir, delTxtReport, True, [],+     opts { consmode = [Text], txtreport = ["TestDir/report.txt"] }),+    ("run_verbose_no_xml_txt", makeTestDir, delTxtReport, True, [],+     opts { consmode = [Verbose], txtreport = ["TestDir/report.txt"] }),+    ("run_quiet_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],+     opts { consmode = [Quiet], xmlreport = ["TestDir/report.xml"],+            txtreport = ["TestDir/report.txt"] }),+    ("run_terminal_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],+     opts { consmode = [Terminal], xmlreport = ["TestDir/report.xml"],+            txtreport = ["TestDir/report.txt"] }),+    ("run_text_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],+     opts { consmode = [Text], xmlreport = ["TestDir/report.xml"],+            txtreport = ["TestDir/report.txt"] }),+    ("run_verbose_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],+     opts { consmode = [Verbose], xmlreport = ["TestDir/report.xml"],+            txtreport = ["TestDir/report.txt"] })+  ] +++  map makeCmdOptTest suiteCombos +++  map makeTestlistTest suiteCombos +++  map makeCmdOptTestlistTest suitePairCombos +++  map makeDualTestlistTest suitePairCombos++tests :: Test+tests = testGroup "Main" (map makeMainTest mainTests)

@@ -0,0 +1,194 @@+{-# LANGUAGE OverloadedStrings #-}++module Tests.Test.HUnitPlus.ReporterUtils where++import Control.Monad+import Data.List+import Distribution.TestSuite(Result(Pass, Fail))+import Test.HUnitPlus.Reporting++import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Strict++data ReportEvent =+    End Double+  | StartSuite+  | EndSuite Double+  | StartCase+  | EndCase Double+  | Skip+  | Progress Strict.Text+  | Failure Strict.Text+  | Error Strict.Text+  | Exception Strict.Text+  | SystemErr Strict.Text+  | SystemOut Strict.Text+    deriving (Show)++instance Eq ReportEvent where+  End e1 == End e2 = e1 == e2+  StartSuite == StartSuite = True+  EndSuite e1 == EndSuite e2 = e1 == e2+  StartCase == StartCase = True+  EndCase e1 == EndCase e2 = e1 == e2+  Skip == Skip = True+  Progress s1 == Progress s2 = s1 == s2+  Failure s1 == Failure s2 = s1 == s2+  Error s1 == Error s2 = s1 == s2+  Exception s1 == Error s2 = Strict.isInfixOf s1 s2+  Error s1 == Exception s2 = Strict.isInfixOf s2 s1+  Exception s1 == Exception s2 = s1 == s2+  SystemErr s1 == SystemErr s2 = s1 == s2+  SystemOut s1 == SystemOut s2 = s1 == s2+  _ == _ = False++type ReporterOp us = (State, us) -> IO (State, us)++loggingReporter :: Reporter [ReportEvent]+loggingReporter = defaultReporter {+    reporterStart = return [],+    reporterEnd = (\time _ events -> return (events ++ [End time])),+    reporterStartSuite = (\_ events -> return (events ++ [StartSuite])),+    reporterEndSuite = (\time _ events -> return (events ++ [EndSuite time])),+    reporterStartCase = (\_ events -> return (events ++ [StartCase])),+    reporterEndCase = (\time _ events -> return (events ++ [EndCase time])),+    reporterSkipCase = (\_ events -> return (events ++ [Skip])),+    reporterCaseProgress = (\msg _ events -> return (events ++ [Progress msg])),+    reporterFailure = (\msg _ events -> return (events ++ [Failure msg])),+    reporterError = (\msg _ events -> return (events ++ [Error msg])),+    reporterSystemErr = (\msg _ events -> return (events ++ [SystemErr msg])),+    reporterSystemOut = (\msg _ events -> return (events ++ [SystemOut msg]))+  }++initState :: State+initState = State { stName = "", stPath = [], stCounts = zeroCounts,+                    stOptions = HashMap.empty, stOptionDescs = [] }++setName :: Strict.Text -> ReporterOp us+setName name (s @ State { stName = _ }, repstate) =+  return (s { stName = name }, repstate)++setOpt :: Strict.Text -> Strict.Text -> ReporterOp us+setOpt key value (s @ State { stOptions = opts }, repstate) =+  return (s { stOptions = HashMap.insert key value opts }, repstate)++pushPath :: Strict.Text -> ReporterOp us+pushPath name (s @ State { stPath = path }, repstate) =+  return (s { stPath = Label name : path }, repstate)++popPath :: ReporterOp us+popPath (s @ State { stPath = _ : path }, repstate) =+  return (s { stPath = path }, repstate)++addOption :: Strict.Text -> Strict.Text -> ReporterOp us+addOption key value (s @ State { stOptions = opts }, repstate) =+  return (s { stOptions = HashMap.insert key value opts }, repstate)++countAsserts :: Word -> ReporterOp us+countAsserts count (s @ State { stCounts = c @ Counts { cAsserts = n } },+                    repstate) =+  return (s { stCounts = c { cAsserts = n + count,+                             cCaseAsserts = count } }, repstate)++countTried :: Word -> ReporterOp us+countTried count (s @ State { stCounts = c @ Counts { cCases = cases,+                                                      cTried = tried } },+                  repstate) =+  return (s { stCounts = c { cCases = cases + count,+                             cTried = tried + count } },+          repstate)++countSkipped :: Word -> ReporterOp us+countSkipped count (s @ State { stCounts = c @ Counts { cSkipped = skipped,+                                                        cCases = cases } },+                  repstate) =+  return (s { stCounts = c { cSkipped = skipped + count,+                             cCases = cases + count } },+          repstate)++countErrors :: Word -> ReporterOp us+countErrors count (s @ State { stCounts = c @ Counts { cErrors = errors } },+                   repstate) =+  return (s { stCounts = c { cErrors = errors + count } }, repstate)++countFailed :: Word -> ReporterOp us+countFailed count (s @ State { stCounts = c @ Counts { cFailures = failed } },+                   repstate) =+  return (s { stCounts = c { cFailures = failed + count } }, repstate)++reportProgress :: Reporter us -> Strict.Text -> ReporterOp us+reportProgress reporter msg (state, repstate) =+  do+    repstate' <- (reporterCaseProgress reporter) msg state repstate+    return (state, repstate')++reportSystemErr :: Reporter us -> Strict.Text -> ReporterOp us+reportSystemErr reporter msg (state, repstate) =+  do+    repstate' <- (reporterSystemErr reporter) msg state repstate+    return (state, repstate')++reportSystemOut :: Reporter us -> Strict.Text -> ReporterOp us+reportSystemOut reporter msg (state, repstate) =+  do+    repstate' <- (reporterSystemOut reporter) msg state repstate+    return (state, repstate')++reportFailure :: Reporter us -> Strict.Text -> ReporterOp us+reportFailure reporter msg (state, repstate) =+  do+    repstate' <- (reporterFailure reporter) msg state repstate+    return (state, repstate')++reportError :: Reporter us -> Strict.Text -> ReporterOp us+reportError reporter msg (state, repstate) =+  do+    repstate' <- (reporterError reporter) msg state repstate+    return (state, repstate')++reportSkip :: Reporter us -> ReporterOp us+reportSkip reporter (state, repstate) =+  do+    repstate' <- (reporterSkipCase reporter) state repstate+    return (state, repstate')++reportStartCase :: Reporter us -> ReporterOp us+reportStartCase reporter (state, repstate) =+  do+    repstate' <- (reporterStartCase reporter) state repstate+    return (state, repstate')++reportEndCase :: Reporter us -> Double -> ReporterOp us+reportEndCase reporter time (state, repstate) =+  do+    repstate' <- (reporterEndCase reporter) time state repstate+    return (state, repstate')++reportStartSuite :: Reporter us -> ReporterOp us+reportStartSuite reporter (state, repstate) =+  do+    repstate' <- (reporterStartSuite reporter) state repstate+    return (state, repstate')++reportEndSuite :: Reporter us -> Double -> ReporterOp us+reportEndSuite reporter time (state, repstate) =+  do+    repstate' <- (reporterEndSuite reporter) time state repstate+    return (state, repstate')++reportEnd :: Reporter us -> Double -> ReporterOp us+reportEnd reporter time (state @ State { stCounts = counts }, repstate) =+  do+    repstate' <- (reporterEnd reporter) time counts repstate+    return (state, repstate')++runReporterTest :: Eq us => Reporter us -> [ReporterOp us] -> us ->+                   (us -> String) -> IO Result+runReporterTest reporter tests expected format =+  do+    initrepstate <- reporterStart reporter+    (_, actual) <- foldM (\state op -> op state) (initState, initrepstate) tests+    if actual == expected+      then return Pass+      else return (Fail ("Expected " ++ format expected +++                        "\nbut got " ++ format actual))

@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++module Tests.Test.HUnitPlus.Reporting(tests) where++import Data.List+import Distribution.TestSuite(Test(..),+                              TestInstance(..),+                              Progress(Finished),+                              Result(Pass, Fail),+                              testGroup)+import Test.HUnitPlus.Reporting+import Tests.Test.HUnitPlus.ReporterUtils(ReportEvent(..))++import qualified Tests.Test.HUnitPlus.ReporterUtils as Utils++type ReporterState = [ReportEvent]+type CombinedReporterState = (ReporterState, ReporterState)+type ReporterOp = Utils.ReporterOp ReporterState+type CombinedReporterOp = Utils.ReporterOp CombinedReporterState+type DefaultReporterOp = Utils.ReporterOp Int++loggingReporter = Utils.loggingReporter++combinedLoggingReporter :: Reporter CombinedReporterState+combinedLoggingReporter = combinedReporter loggingReporter loggingReporter++reportSystemErr = Utils.reportSystemErr combinedLoggingReporter+reportSystemOut = Utils.reportSystemOut combinedLoggingReporter+reportFailure = Utils.reportFailure combinedLoggingReporter+reportError = Utils.reportError combinedLoggingReporter+reportSkip = Utils.reportSkip combinedLoggingReporter+reportProgress = Utils.reportProgress combinedLoggingReporter+reportStartCase = Utils.reportStartCase combinedLoggingReporter+reportEndCase = Utils.reportEndCase combinedLoggingReporter+runReporterTest = Utils.runReporterTest combinedLoggingReporter+reportStartSuite = Utils.reportStartSuite combinedLoggingReporter+reportEndSuite = Utils.reportEndSuite combinedLoggingReporter+reportEnd = Utils.reportEnd combinedLoggingReporter++reporterActions :: [(String, CombinedReporterOp, ReporterState)]+reporterActions = [+    ("systemErr", reportSystemErr "Error Message", [SystemErr "Error Message"]),+    ("systemOut", reportSystemOut "Output Message",+     [SystemOut "Output Message"]),+    ("failure", reportFailure "Failure Message", [Failure "Failure Message"]),+    ("error", reportError "Error Message", [Error "Error Message"]),+    ("progress", reportProgress "Progress Message",+     [Progress "Progress Message"]),+    ("skip", reportSkip, [Skip]),+    ("startCase", reportStartCase, [StartCase]),+    ("endCase", reportEndCase 1.0, [EndCase 1.0]),+    ("startSuite", reportStartSuite, [StartSuite]),+    ("endSuite", reportEndSuite 2.0, [EndSuite 2.0]),+    ("end", reportEnd 3.0, [End 3.0])+  ]++defaultReporterCases :: [(String, State -> Int -> IO Int, Int)]+defaultReporterCases = [+    ("systemErr", (reporterSystemErr defaultReporter) "Error Message", 1),+    ("systemOut", (reporterSystemOut defaultReporter) "Output Message", 2),+    ("failure", (reporterFailure defaultReporter) "Failure Message", 3),+    ("error", (reporterError defaultReporter) "Error Message", 4),+    ("progress", (reporterCaseProgress defaultReporter) "Progress Message", 5),+    ("skip", reporterSkipCase defaultReporter, 6),+    ("startCase", reporterStartCase defaultReporter, 7),+    ("endCase", (reporterEndCase defaultReporter) 1.0, 8),+    ("startSuite", reporterStartSuite defaultReporter, 9),+    ("endSuite", (reporterEndSuite defaultReporter) 2.0, 10),+    ("end", (reporterEnd defaultReporter) 3.0 . stCounts, 11)+  ]++reporterCases :: [[(String, CombinedReporterOp, ReporterState)]]+reporterCases =+  map (: []) reporterActions +++  foldr (\a accum ->+          foldr (\b accum -> [a, b] : accum)+                accum reporterActions)+        [] reporterActions++genCombinedReporterTest :: [(String, CombinedReporterOp, ReporterState)] -> Test+genCombinedReporterTest testactions =+  let+    name = intercalate "_" (map (\(a, _, _) -> a) testactions)+    ops = map (\(_, a, _) -> a) testactions+    log = concat (map (\(_, _, a) -> a) testactions)+    expected = (log, log)++    out = TestInstance { name = "combinedReporter_" ++ name,+                         tags = [], options = [],+                         setOption = (\_ _ -> Right out),+                         run = runReporterTest ops expected show >>=+                               return . Finished }+  in+    Test out++genDefaultReporterTest :: (String, State -> Int -> IO Int, Int) -> Test+genDefaultReporterTest (name, reporterAction, reporterState) =+  let+    runTest =+      do+        result <- reporterAction Utils.initState reporterState+        if result == reporterState+          then return (Finished Pass)+          else return (Finished (Fail "defaultReporter altered state!"))++    out = TestInstance { name = "defaultReporter_" ++ name,+                         tags = [], options = [], run = runTest,+                         setOption = (\_ _ -> Right out) }+  in+    Test out+++tests :: Test+tests = testGroup "Reporting" (map genCombinedReporterTest reporterCases +++                               map genDefaultReporterTest defaultReporterCases)

@@ -0,0 +1,7 @@+module Tests.Test.HUnitPlus.Text where++import Distribution.TestSuite+import Test.HUnitPlus.Text++tests :: Test+tests = testGroup "Text" []

@@ -0,0 +1,348 @@+{-# 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)