rhi/idris2-tap
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Wiki Activity

allow multiple (and-ed) filters

Browse source
This commit is contained in:
rhiannon morris 2023-09-17 16:59:21 +02:00
parent 28f0546903
commit 46d94df444
2 changed files with 25 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
TAP.idr
View file

@ -356,26 +356,33 @@ parameters (skipNotes : Bool)
all id <$> traverse (\t => run' (assert_smaller tests t)) tests' 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 mutual
||| filter tests by whether a string occurs in their name or in the name of ||| filter tests by whether a string occurs in their name or in the name of
||| any of their parent groups ||| any of their parent groups
export export
filterMatch : Maybe String -> List Test -> List Test filterMatch : List String -> List Test -> List Test
filterMatch Nothing tests = tests filterMatch [] tests = tests
filterMatch (Just pat) tests = filterMatch pats tests =
mapMaybe (\t => filterMatch1 pat (assert_smaller tests t)) 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 ||| 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 ||| any of their parent groups. return `Nothing` if nothing remains
export export
filterMatch1 : String -> Test -> Maybe Test filterMatch1 : List String -> Test -> Maybe Test
filterMatch1 pat test@(One base) = filterMatch1 pats test@(One base) = do
guard (pat `isInfixOf` base.label) $> test guard $ null $ filterMatchStr pats base.label
filterMatch1 pat whole@(Group label tests) = pure test
if pat `isInfixOf` label then Just whole else filterMatch1 pats whole@(Group label tests) =
let res = filterMatch (Just pat) tests in case filterMatchStr pats label of
guard (any isRealTest res) $> Group label res [] => Just whole
filterMatch1 pat note@(Note _) = Just note 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 ||| run some tests, and return `ExitSuccess` if they were all ok, and

12
TAP/Options.idr
View file

@ -36,10 +36,10 @@ record Options where
||| which TAP version to output ||| which TAP version to output
version : TAPVersion version : TAPVersion
||| `-F`, `--filter`: ||| `-F`, `--filter`:
||| search for a substring in test or group names. ||| search for substrings in test or group names.
||| if it is present in a group name then all subtests are run ||| if there are several, then each must be present somewhere in the
||| regardless of their own names ||| test's name or in the name of one of its parent groups
pattern : Maybe String pattern : List String
||| `-c`, `--color`, `--colour`: ||| `-c`, `--color`, `--colour`:
||| colour code test results and a few other things. ||| colour code test results and a few other things.
||| this is not TAP compliant so it is off by default. ||| this is not TAP compliant so it is off by default.
@ -54,7 +54,7 @@ export
defaultOpts : Options defaultOpts : Options
defaultOpts = Opts { defaultOpts = Opts {
version = V13, version = V13,
pattern = Nothing, pattern = [],
color = False, color = False,
skipComments = False skipComments = False
} }
@ -86,7 +86,7 @@ setTapVer ver opts =
private private
setFilter : String -> Mod setFilter : String -> Mod
setFilter str opts = pure $ {pattern := Just str} opts setFilter str opts = pure $ {pattern $= (str ::)} opts
parameters (header : String) parameters (header : String)
mutual mutual