Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Improve --hide-successes to not print headings for empty test subtrees #403

Merged
merged 1 commit into from
Dec 11, 2023
Merged

Improve --hide-successes to not print headings for empty test subtrees #403

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 15 additions & 7 deletions core/Test/Tasty/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -540,7 +540,7 @@ annotatePath = go mempty
go :: Seq.Seq TestName -> AnnTestTree OptionSet -> AnnTestTree (OptionSet, Path)
go path = \case
AnnEmptyTestTree -> AnnEmptyTestTree
AnnSingleTest opts name tree ->
AnnSingleTest opts name tree ->
AnnSingleTest (opts, path |> name) name tree
AnnTestGroup opts name trees ->
let newPath = path |> name in
Expand All @@ -554,7 +554,15 @@ annotatePath = go mempty
filterByPattern :: AnnTestTree (OptionSet, Path) -> AnnTestTree OptionSet
filterByPattern = snd . go (Any False)
where
go
mkGroup opts name xs = case filter isNonEmpty xs of
[] -> AnnEmptyTestTree
ys -> AnnTestGroup opts name ys

isNonEmpty = \case
AnnEmptyTestTree -> False
_ -> True

go
:: ForceTestMatch
-> AnnTestTree (OptionSet, Path)
-> (TestMatched, AnnTestTree OptionSet)
Expand All @@ -565,22 +573,22 @@ filterByPattern = snd . go (Any False)
AnnSingleTest (opts, path) name tree
| getAny forceMatch || testPatternMatches (lookupOption opts) path
-> (Any True, AnnSingleTest opts name tree)
| otherwise
| otherwise
-> (Any False, AnnEmptyTestTree)

AnnTestGroup (opts, _) name [] ->
(forceMatch, AnnTestGroup opts name [])
AnnTestGroup _ _ [] ->
(forceMatch, AnnEmptyTestTree)

AnnTestGroup (opts, _) name trees ->
case lookupOption opts of
Parallel ->
bimap
mconcat
(AnnTestGroup opts name)
(mkGroup opts name)
(unzip (map (go forceMatch) trees))
Sequential _ ->
second
(AnnTestGroup opts name)
(mkGroup opts name)
(mapAccumR go forceMatch trees)

AnnWithResource (opts, _) res0 tree ->
Expand Down
Loading