tasty-silver 3.1.4 → 3.1.5

raw patch · 3 files changed

+49/−18 lines, 3 files

Files

• CHANGELOG.md +8/−0
• Test/Tasty/Silver/Interactive.hs +40/−17
• tasty-silver.cabal +1/−1

@@ -1,6 +1,14 @@ Changes ======= +Version 3.1.5+-------------++* Add experimental --regex-include option to select tests using a regex.+  This option is highly experimental and may change in later versions!+* The --regex-include/--regex-exclude option may be given multiple times now.+  The exclusion regexes are applied first, after that all inclusion regexes.+ Version 3.1.4 ------------- 

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} -- | Golden test management, interactive mode. Runs the tests, and asks -- the user how to proceed in case of failure or missing golden standard.@@ -80,24 +81,43 @@ data RegexFilter   = RFInclude String -- include tests that match   | RFExclude String -- exclude tests that match-  | RFNone   deriving (Typeable) -{-instance IsOption RegexFilter where-  defaultValue = RFNone-  parseValue = fmap RFInclude . either (const Nothing) Just . RS.compile R.defaultCompOpt R.defaultExecOpt-  optionName = return "regex-include"-  optionHelp = return "Include only tests matching a regex (experimental)."-}+newtype ExcludeFilters = ExcludeFilters [RegexFilter]+  deriving (Typeable) +newtype IncludeFilters = IncludeFilters [RegexFilter]+  deriving (Typeable)+ compileRegex :: String -> Maybe RS.Regex compileRegex = either (const Nothing) Just . RS.compile R.defaultCompOpt R.defaultExecOpt -instance IsOption RegexFilter where-  defaultValue = RFNone-  parseValue = \x -> fmap (const (RFExclude x)) $ compileRegex x+parseFilter :: forall v . IsOption v => (String -> RegexFilter) -> ([RegexFilter] -> v) -> Parser v+parseFilter mkRF mkV = mkV <$> many ( option parse ( long name <> help helpString))+  where+    name = untag (optionName :: Tagged v String)+    helpString = untag (optionHelp :: Tagged v String)+    parse = (str >>=+        either (\err -> readerError $ "Could not parse " ++ name ++ ": " ++ err) (\_ -> mkRF <$> str)+        <$> RS.compile R.defaultCompOpt R.defaultExecOpt)++parseValue1 :: (String -> RegexFilter) -> String -> Maybe [RegexFilter]+parseValue1 f x = fmap (const $ [f x]) $ compileRegex x++instance IsOption ExcludeFilters where+  defaultValue = ExcludeFilters []+  parseValue = fmap ExcludeFilters . parseValue1 RFExclude   optionName = return "regex-exclude"   optionHelp = return "Exclude tests matching a regex (experimental)."+  optionCLParser = parseFilter RFExclude ExcludeFilters +instance IsOption IncludeFilters where+  defaultValue = IncludeFilters []+  parseValue = fmap IncludeFilters . parseValue1 RFInclude+  optionName = return "regex-include"+  optionHelp = return "Include only tests matching a regex (experimental)."+  optionCLParser = parseFilter RFInclude IncludeFilters+ data ResultStatus = RPass | RFail | RMismatch GoldenResultI  type GoldenStatus = GoldenResultI@@ -110,15 +130,21 @@     , Option (Proxy :: Proxy HideSuccesses)     , Option (Proxy :: Proxy UseColor)     , Option (Proxy :: Proxy NumThreads)-    , Option (Proxy :: Proxy RegexFilter)+    , Option (Proxy :: Proxy ExcludeFilters)+    , Option (Proxy :: Proxy IncludeFilters)     ] $   \opts tree ->       Just $ runTestsInteractive opts (filterWithRegex opts tree)  filterWithRegex :: OptionSet -> TestTree -> TestTree-filterWithRegex opts tree = case lookupOption opts of-    RFNone -> tree-    RFInclude rgx -> filter' (R.matchTest $ fromJust $ compileRegex rgx)+filterWithRegex opts tree = foldl (filterWithRegex1 opts) tree (excRgxs ++ incRgxs)+  where ExcludeFilters excRgxs = lookupOption opts+        IncludeFilters incRgxs = lookupOption opts+++filterWithRegex1 :: OptionSet -> TestTree -> RegexFilter -> TestTree+filterWithRegex1 opts tree rf = case rf of+    RFInclude rgx -> filter' (R.matchTest (fromJust $ compileRegex rgx))     RFExclude rgx -> filter' (not . R.matchTest (fromJust $ compileRegex rgx))   where x <//> y = x ++ "/" ++ y         filter' :: (String -> Bool) -> TestTree@@ -126,10 +152,7 @@             let alg :: TreeFold [String -> Maybe TestTree]                 alg = trivialFold                     { foldSingle = \_ nm t -> [\pth -> if pred' (pth <//> nm) then Just (SingleTest nm t) else Nothing]-                    , foldGroup  = \nm chlds -> [\pth -> let pth' = pth <//> nm-                                        in if pred' pth'-                                            then Just $ TestGroup nm (catMaybes $ map (\x -> x (pth <//> nm)) chlds)-                                            else Nothing]+                    , foldGroup  = \nm chlds -> [\pth -> Just $ TestGroup nm (catMaybes $ map (\x -> x (pth <//> nm)) chlds)]                     }                 [root] = foldTestTree alg opts tree              in maybe (testGroup "" []) (id) (root "")

@@ -1,5 +1,5 @@ name:                tasty-silver-version:             3.1.4+version:             3.1.5 synopsis:            Golden tests support for tasty. Fork of tasty-golden. description:   This package provides support for «golden testing».