allow multiple (and-ed) filters
This commit is contained in:
parent
28f0546903
commit
46d94df444
2 changed files with 25 additions and 18 deletions
31
TAP.idr
31
TAP.idr
|
@ -356,26 +356,33 @@ parameters (skipNotes : Bool)
|
|||
all id <$> traverse (\t => run' (assert_smaller tests t)) tests'
|
||||
|
||||
|
||||
export
|
||||
filterMatchStr : List String -> String -> List String
|
||||
filterMatchStr pats label = filter (\p => not $ p `isInfixOf` label) pats
|
||||
|
||||
mutual
|
||||
||| filter tests by whether a string occurs in their name or in the name of
|
||||
||| any of their parent groups
|
||||
export
|
||||
filterMatch : Maybe String -> List Test -> List Test
|
||||
filterMatch Nothing tests = tests
|
||||
filterMatch (Just pat) tests =
|
||||
mapMaybe (\t => filterMatch1 pat (assert_smaller tests t)) tests
|
||||
filterMatch : List String -> List Test -> List Test
|
||||
filterMatch [] tests = tests
|
||||
filterMatch pats tests =
|
||||
mapMaybe (\t => filterMatch1 pats $ assert_smaller tests t) tests
|
||||
|
||||
||| filter subtests by whether a string occurs in their name or in the name of
|
||||
||| any of their parent groups. return `Nothing` if nothing remains
|
||||
export
|
||||
filterMatch1 : String -> Test -> Maybe Test
|
||||
filterMatch1 pat test@(One base) =
|
||||
guard (pat `isInfixOf` base.label) $> test
|
||||
filterMatch1 pat whole@(Group label tests) =
|
||||
if pat `isInfixOf` label then Just whole else
|
||||
let res = filterMatch (Just pat) tests in
|
||||
guard (any isRealTest res) $> Group label res
|
||||
filterMatch1 pat note@(Note _) = Just note
|
||||
filterMatch1 : List String -> Test -> Maybe Test
|
||||
filterMatch1 pats test@(One base) = do
|
||||
guard $ null $ filterMatchStr pats base.label
|
||||
pure test
|
||||
filterMatch1 pats whole@(Group label tests) =
|
||||
case filterMatchStr pats label of
|
||||
[] => Just whole
|
||||
rest => do let res = filterMatch rest tests
|
||||
guard $ any isRealTest res
|
||||
pure $ Group label res
|
||||
filterMatch1 _ note@(Note _) = Just note
|
||||
|
||||
|
||||
||| run some tests, and return `ExitSuccess` if they were all ok, and
|
||||
|
|
|
@ -36,10 +36,10 @@ record Options where
|
|||
||| which TAP version to output
|
||||
version : TAPVersion
|
||||
||| `-F`, `--filter`:
|
||||
||| search for a substring in test or group names.
|
||||
||| if it is present in a group name then all subtests are run
|
||||
||| regardless of their own names
|
||||
pattern : Maybe String
|
||||
||| search for substrings in test or group names.
|
||||
||| if there are several, then each must be present somewhere in the
|
||||
||| test's name or in the name of one of its parent groups
|
||||
pattern : List String
|
||||
||| `-c`, `--color`, `--colour`:
|
||||
||| colour code test results and a few other things.
|
||||
||| this is not TAP compliant so it is off by default.
|
||||
|
@ -54,7 +54,7 @@ export
|
|||
defaultOpts : Options
|
||||
defaultOpts = Opts {
|
||||
version = V13,
|
||||
pattern = Nothing,
|
||||
pattern = [],
|
||||
color = False,
|
||||
skipComments = False
|
||||
}
|
||||
|
@ -86,7 +86,7 @@ setTapVer ver opts =
|
|||
|
||||
private
|
||||
setFilter : String -> Mod
|
||||
setFilter str opts = pure $ {pattern := Just str} opts
|
||||
setFilter str opts = pure $ {pattern $= (str ::)} opts
|
||||
|
||||
parameters (header : String)
|
||||
mutual
|
||||
|
|
Loading…
Reference in a new issue