add flag to skip printing notes
This commit is contained in:
parent
4dba693a5f
commit
9701ec3cd0
2 changed files with 35 additions and 25 deletions
43
TAP.idr
43
TAP.idr
|
@ -294,27 +294,28 @@ run1' (index, test) = do
|
|||
putOk' Yellow True index "\{test.label} # todo \{reason}"
|
||||
pure $ toBool res
|
||||
|
||||
mutual
|
||||
||| run a test or group
|
||||
private
|
||||
run' : (Nat, Test) -> Runner Bool
|
||||
run' (index, One test) = run1' (index, test)
|
||||
run' (index, Group label tests) = do
|
||||
putIndentLines [!(col Magenta "# Subtest: ") ++ label]
|
||||
res <- local {indent $= plus 4} $ runList tests
|
||||
putOk res index label
|
||||
pure res
|
||||
run' (_, Note note) = do
|
||||
putIndentLines [!(col Magenta "# ") ++ note]
|
||||
pure True
|
||||
parameters (skipNotes : Bool)
|
||||
mutual
|
||||
||| run a test or group
|
||||
private
|
||||
run' : (Nat, Test) -> Runner Bool
|
||||
run' (index, One test) = run1' (index, test)
|
||||
run' (index, Group label tests) = do
|
||||
putIndentLines [!(col Magenta "# Subtest: ") ++ label]
|
||||
res <- local {indent $= plus 4} $ runList tests
|
||||
putOk res index label
|
||||
pure res
|
||||
run' (_, Note note) = do
|
||||
unless skipNotes $ putIndentLines [!(col Magenta "# ") ++ note]
|
||||
pure True
|
||||
|
||||
private
|
||||
||| run several tests
|
||||
runList : List Test -> Runner Bool
|
||||
runList tests = do
|
||||
putColor Cyan $ header tests
|
||||
let tests' = numbered isRealTest tests
|
||||
all id <$> traverse (\t => run' (assert_smaller tests t)) tests'
|
||||
private
|
||||
||| run several tests
|
||||
runList : List Test -> Runner Bool
|
||||
runList tests = do
|
||||
putColor Cyan $ header tests
|
||||
let tests' = numbered isRealTest tests
|
||||
all id <$> traverse (\t => run' (assert_smaller tests t)) tests'
|
||||
|
||||
|
||||
mutual
|
||||
|
@ -347,7 +348,7 @@ main' : Options -> List Test -> IO ExitCode
|
|||
main' opts tests = do
|
||||
let tests = filterMatch opts.pattern $
|
||||
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)
|
||||
then ExitSuccess
|
||||
else ExitFailure 70
|
||||
|
|
|
@ -43,16 +43,20 @@ record Options where
|
|||
||| `-c`, `--color`, `--colour`:
|
||||
||| colour code test results and a few other things.
|
||||
||| 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
|
||||
||| (version 13 (because of `prove`), no filter, no colour)
|
||||
export
|
||||
defaultOpts : Options
|
||||
defaultOpts = Opts {
|
||||
version = V13,
|
||||
pattern = Nothing,
|
||||
color = False
|
||||
version = V13,
|
||||
pattern = Nothing,
|
||||
color = False,
|
||||
skipComments = False
|
||||
}
|
||||
|
||||
||| value for each option.
|
||||
|
@ -114,6 +118,11 @@ parameters (header : String)
|
|||
description = "colour-code results (not TAP compliant)",
|
||||
shortNames = ['c'], longNames = ["color", "colour"],
|
||||
argDescr = NoArg $ pure . {color := True}
|
||||
},
|
||||
MkOpt {
|
||||
description = "skip printing comments in the output",
|
||||
shortNames = ['q'], longNames = ["skip-comments"],
|
||||
argDescr = NoArg $ pure . {skipComments := True}
|
||||
}
|
||||
]
|
||||
|
||||
|
|
Loading…
Reference in a new issue