Allow --pattern|-p option to repeat

The effect of multiple -p options is the same as &&-ing the expressions
together, but allowing them to be specified in separate options makes
scripting test commands simpler.

core-tests/SequentialTestGroup.hs

@@ -81,7 +81,7 @@ tree6 = Sequentially () [tree3, emptySeqTree, tree3]
 
 filterTestTree :: HasCallStack => String -> [TestName]
 filterTestTree pattern =
-  testsNames (singleOption (TestPattern (Just expr))) $
+  testsNames (singleOption (TestPattern [expr])) $
     testGroup "A"
       [ emptyTest "B"
       , emptyTest "C"

core-tests/test.hs

@@ -46,9 +46,9 @@ patternTests = testGroup "Patterns"
   , testCase "AWK expression"
       (o "$3 ~ /r/ || $2 != \"Europe\"" @?= ["Tests.Europe.Paris","Tests.Europe.Berlin","Tests.North America.Ottawa","Tests.North America.Washington DC"])
   , testCase "Simple ERE is parsed as such" $ -- #220
-      parseTestPattern "/foo/" @?= Just (TestPattern (Just (ERE "foo")))
+      parseTestPattern "/foo/" @?= Just (TestPattern [ERE "foo"])
   , testCase "Dashes are acceptable in raw patterns" $ -- #220
-      parseTestPattern "type-checking" @?= Just (TestPattern (Just (ERE "type-checking")))
+      parseTestPattern "type-checking" @?= Just (TestPattern [ERE "type-checking"])
   , testCase ". is a field separator (works as a raw pattern)" $
       (o "ca.Ot" @?= ["Tests.North America.Ottawa"])
   , testCase ". is a field separator (works inside an AWK expression)" $

core/Test/Tasty/Ingredients/ConsoleReporter.hs

@@ -487,13 +487,13 @@ consoleTestReporter = TestReporter consoleTestReporterOptions $ \opts tree ->
 
 appendPatternIfTestFailed
   :: [TestName] -- ^ list of (pre-intercalated) test names
-  -> Maybe Expr -- ^ current pattern, if any
+  -> [Expr]     -- ^ current patterns, if any
   -> [TestName] -- ^ name of current test, represented as a list of group names
   -> Result     -- ^ vanilla result
   -> Result
 appendPatternIfTestFailed [_] _ _ res = res -- if there is only one test, nothing to refine
 appendPatternIfTestFailed _ _ [] res  = res -- should be impossible
-appendPatternIfTestFailed tests currentPattern (name : names) res = case resultOutcome res of
+appendPatternIfTestFailed tests currentPatterns (name : names) res = case resultOutcome res of
   Success -> res
   Failure{} -> res { resultDescription = resultDescription res ++ msg }
   where
@@ -508,7 +508,7 @@ appendPatternIfTestFailed tests currentPattern (name : names) res = case resultO
 
     individualPattern = findPattern (filter (name `isInfixOf`) tests) name names
 
-    pattern = maybe id And currentPattern individualPattern
+    pattern = foldr And individualPattern currentPatterns
 
 consoleTestReporterOptions :: [OptionDescription]
 consoleTestReporterOptions =

core/Test/Tasty/Patterns.hs

@@ -1,6 +1,6 @@
 -- | Test patterns
 
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 
 module Test.Tasty.Patterns
   ( TestPattern(..)
@@ -18,6 +18,7 @@ import Test.Tasty.Patterns.Parser
 import Test.Tasty.Patterns.Eval
 
 import Data.Char
+import Data.Foldable (fold)
 import Data.Typeable
 import Options.Applicative hiding (Success)
 #if !MIN_VERSION_base(4,11,0)
@@ -28,23 +29,27 @@ import Data.Monoid
 newtype TestPattern =
   -- | @since 1.1
   TestPattern
-    (Maybe Expr)
+    [Expr]
   deriving
   ( Typeable
   , Show -- ^ @since 1.1
   , Eq   -- ^ @since 1.1
+#if MIN_VERSION_base(4,11,0)
+  , Semigroup
+#endif
+  , Monoid
   )
 
 -- | @since 1.0
 noPattern :: TestPattern
-noPattern = TestPattern Nothing
+noPattern = TestPattern []
 
 instance IsOption TestPattern where
   defaultValue = noPattern
   parseValue = parseTestPattern
   optionName = return "pattern"
   optionHelp = return "Select only tests which satisfy a pattern or awk expression"
-  optionCLParser = mkOptionCLParser (short 'p' <> metavar "PATTERN")
+  optionCLParser = fmap fold . some $ mkOptionCLParser (short 'p' <> metavar "PATTERN")
 
 -- | @since 1.2
 parseExpr :: String -> Maybe Expr
@@ -57,7 +62,7 @@ parseExpr s
 parseTestPattern :: String -> Maybe TestPattern
 parseTestPattern s
   | null s = Just noPattern
-  | otherwise = TestPattern . Just <$> parseExpr s
+  | otherwise = TestPattern . pure <$> parseExpr s
 
 -- | @since 1.2
 exprMatches :: Expr -> Path -> Bool
@@ -68,7 +73,5 @@ exprMatches e fields =
 
 -- | @since 1.0
 testPatternMatches :: TestPattern -> Path -> Bool
-testPatternMatches pat fields =
-  case pat of
-    TestPattern Nothing -> True
-    TestPattern (Just e) -> exprMatches e fields
+testPatternMatches (TestPattern es) fields =
+  all (flip exprMatches fields) es