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.

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

Add option for printing the number of QuickCheck tests and shrinks #431

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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
27 changes: 25 additions & 2 deletions quickcheck/Test/Tasty/QuickCheck.hs
Original file line number Diff line number Diff line change
Expand Up @@ -283,8 +283,31 @@ quickCheck yieldProgress args
= (.) (QC.quickCheckWithResult args)
$ QCP.callback
$ QCP.PostTest QCP.NotCounterexample
$ \QC.MkState {QC.maxSuccessTests, QC.numSuccessTests} _ ->
yieldProgress $ emptyProgress {progressPercent = fromIntegral numSuccessTests / fromIntegral maxSuccessTests}
$ \st@QC.MkState {QC.maxSuccessTests, QC.numSuccessTests} _ ->
yieldProgress $
if QC.numTotTryShrinks st > 0 then
emptyProgress {
progressText = showShrinkCount st True
}
else
emptyProgress {
progressPercent = fromIntegral numSuccessTests / fromIntegral maxSuccessTests
}

-- Based on 'QuickCheck.Test.failureSummaryAndReason'.
showShrinkCount :: QC.State -> Bool -> String
showShrinkCount st full = count
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we just showShrinkCount st full = concat [...]?

where
count :: String
count =
concat [
show (QC.numSuccessShrinks st) ++
concat [ "." ++ show (QC.numTryShrinks st) | showNumTryShrinks ] ++
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I spent quite some time deciphering that concat [ xs | c ] is a fancy way to say if c then xs else "". Could we please use the latter form?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The intermediate output seems to be something like 2.1 shrinks. What is it supposed to mean?

I understand that you adapted QuickCheck.Test.failureSummaryAndReason, which has the same cryptic behavior. Could we just show (QC.numSuccessShrinks st) ++ " shrink" ++ (if ... then "" else "s")?

" shrink" ++
(if QC.numSuccessShrinks st == 1 && not showNumTryShrinks then "" else "s")
| QC.numSuccessShrinks st > 0 || showNumTryShrinks ]
where
showNumTryShrinks = full && QC.numTryShrinks st > 0

successful :: QC.Result -> Bool
successful r =
Expand Down
7 changes: 5 additions & 2 deletions quickcheck/tests/test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -110,8 +110,11 @@ main =
resultDescription =~ "Use .* to reproduce"

-- Run the test suite manually and check that progress does not go beyond 100%
, testProperty "Percent Complete" $ withMaxSuccess 1000 $ \(_ :: Int) -> ioProperty $ threadDelay 10000

, testProperty "Percent Complete" $
withMaxSuccess 1000 $ \(_ :: Int) -> ioProperty $ threadDelay 10000
, testProperty "Number of shrinks" $
expectFailure $ withMaxSize 1000 $ \(Large (x :: Int)) ->
ioProperty $ threadDelay 100000 >> pure (x <= 100)
]

run' :: Testable p => p -> IO Result
Expand Down
Loading