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

add flag to skip printing notes

Browse source
This commit is contained in:
rhiannon morris 2023-03-03 21:04:46 +01:00
parent 4dba693a5f
commit 9701ec3cd0
2 changed files with 35 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
TAP.idr
View file

@ -294,27 +294,28 @@ run1' (index, test) = do
putOk' Yellow True index "\{test.label} # todo \{reason}" putOk' Yellow True index "\{test.label} # todo \{reason}"
pure $ toBool res pure $ toBool res
mutual parameters (skipNotes : Bool)
||| run a test or group mutual
private ||| run a test or group
run' : (Nat, Test) -> Runner Bool private
run' (index, One test) = run1' (index, test) run' : (Nat, Test) -> Runner Bool
run' (index, Group label tests) = do run' (index, One test) = run1' (index, test)
putIndentLines [!(col Magenta "# Subtest: ") ++ label] run' (index, Group label tests) = do
res <- local {indent $= plus 4} $ runList tests putIndentLines [!(col Magenta "# Subtest: ") ++ label]
putOk res index label res <- local {indent $= plus 4} $ runList tests
pure res putOk res index label
run' (_, Note note) = do pure res
putIndentLines [!(col Magenta "# ") ++ note] run' (_, Note note) = do
pure True unless skipNotes $ putIndentLines [!(col Magenta "# ") ++ note]
pure True
private private
||| run several tests ||| run several tests
runList : List Test -> Runner Bool runList : List Test -> Runner Bool
runList tests = do runList tests = do
putColor Cyan $ header tests putColor Cyan $ header tests
let tests' = numbered isRealTest tests let tests' = numbered isRealTest tests
all id <$> traverse (\t => run' (assert_smaller tests t)) tests' all id <$> traverse (\t => run' (assert_smaller tests t)) tests'
mutual mutual
@ -347,7 +348,7 @@ main' : Options -> List Test -> IO ExitCode
main' opts tests = do main' opts tests = do
let tests = filterMatch opts.pattern $ let tests = filterMatch opts.pattern $
case opts.version of V13 => flatten tests; V14 => tests case opts.version of V13 => flatten tests; V14 => tests
let act = do putVersion opts.version; runList tests let act = do putVersion opts.version; runList opts.skipComments tests
pure $ if !(runReaderT (RE 0 opts.color) act) pure $ if !(runReaderT (RE 0 opts.color) act)
then ExitSuccess then ExitSuccess
else ExitFailure 70 else ExitFailure 70

17
TAP/Options.idr
View file

@ -43,16 +43,20 @@ record Options where
||| `-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.
color : Bool color : Bool
||| `-q`, `--skip-comments`:
||| skip printing comments in the output
skipComments : Bool
||| default options ||| default options
||| (version 13 (because of `prove`), no filter, no colour) ||| (version 13 (because of `prove`), no filter, no colour)
export export
defaultOpts : Options defaultOpts : Options
defaultOpts = Opts { defaultOpts = Opts {
version = V13, version = V13,
pattern = Nothing, pattern = Nothing,
color = False color = False,
skipComments = False
} }
||| value for each option. ||| value for each option.
@ -114,6 +118,11 @@ parameters (header : String)
description = "colour-code results (not TAP compliant)", description = "colour-code results (not TAP compliant)",
shortNames = ['c'], longNames = ["color", "colour"], shortNames = ['c'], longNames = ["color", "colour"],
argDescr = NoArg $ pure . {color := True} argDescr = NoArg $ pure . {color := True}
},
MkOpt {
description = "skip printing comments in the output",
shortNames = ['q'], longNames = ["skip-comments"],
argDescr = NoArg $ pure . {skipComments := True}
} }
] ]