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

Implement --quickcheck-timeout for individual tests within a property #425

Merged
merged 2 commits into from
Jul 19, 2024
Merged
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
4 changes: 3 additions & 1 deletion core/Test/Tasty/Ingredients/ConsoleReporter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -169,9 +169,10 @@ buildTestOutput opts tree =
("", pct) -> printf "%.0f%% " pct
(txt, 0.0) -> printf "%s" txt
(txt, pct) -> printf "%s: %.0f%% " txt pct
putChar '\r'
-- A new progress message may be shorter than the previous one
-- so we must clean whole line and print anew.
putChar '\r'
clearLine
putStr testNamePadded
infoOk msg
hFlush stdout
Expand All @@ -190,6 +191,7 @@ buildTestOutput opts tree =

when getAnsiTricks $ do
putChar '\r'
clearLine
putStr testNamePadded

printFn (resultShortDescription result)
Expand Down
5 changes: 5 additions & 0 deletions quickcheck/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
Changes
=======

Version 0.11.1
--------------

* Add timeouts for individual tests within a property.

Version 0.11
--------------

Expand Down
24 changes: 22 additions & 2 deletions quickcheck/Test/Tasty/QuickCheck.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module Test.Tasty.QuickCheck
, QuickCheckMaxRatio(..)
, QuickCheckVerbose(..)
, QuickCheckMaxShrinks(..)
, QuickCheckTimeout(..)
-- * Re-export of Test.QuickCheck
, module Test.QuickCheck
-- * Internal
Expand All @@ -20,7 +21,7 @@ module Test.Tasty.QuickCheck
, optionSetToArgs
) where

import Test.Tasty ( testGroup )
import Test.Tasty ( testGroup, Timeout(..) )
import Test.Tasty.Providers
import Test.Tasty.Options
import qualified Test.QuickCheck as QC
Expand Down Expand Up @@ -118,6 +119,12 @@ newtype QuickCheckVerbose = QuickCheckVerbose Bool
newtype QuickCheckMaxShrinks = QuickCheckMaxShrinks Int
deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable)

-- | Timeout for individual tests within a property.
--
-- @since 0.11.1
newtype QuickCheckTimeout = QuickCheckTimeout Timeout
deriving (Eq, Ord, Typeable)

instance IsOption QuickCheckTests where
defaultValue = 100
parseValue =
Expand Down Expand Up @@ -175,6 +182,13 @@ instance IsOption QuickCheckMaxShrinks where
optionHelp = return "Number of shrinks allowed before QuickCheck will fail a test"
optionCLParser = mkOptionCLParser $ metavar "NUMBER"

instance IsOption QuickCheckTimeout where
defaultValue = QuickCheckTimeout defaultValue
parseValue = fmap QuickCheckTimeout . parseValue
optionName = return "quickcheck-timeout"
optionHelp = return "Timeout for individual tests within a QuickCheck property (suffixes: ms,s,m,h; default: s)"
optionCLParser = mkOptionCLParser $ metavar "DURATION"

-- | Convert tasty options into QuickCheck options.
--
-- This is a low-level function that was originally added for tasty-hspec
Expand Down Expand Up @@ -221,18 +235,24 @@ instance IsTest QC where
, Option (Proxy :: Proxy QuickCheckMaxRatio)
, Option (Proxy :: Proxy QuickCheckVerbose)
, Option (Proxy :: Proxy QuickCheckMaxShrinks)
, Option (Proxy :: Proxy QuickCheckTimeout)
]

run opts (QC prop) yieldProgress = do
(_, args) <- optionSetToArgs opts
let
QuickCheckShowReplay showReplay = lookupOption opts
QuickCheckVerbose verbose = lookupOption opts
QuickCheckTimeout timeout = lookupOption opts
applyTimeout = case timeout of
Timeout micros _
| micros <= toInteger (maxBound :: Int) -> QC.within (fromInteger micros)
_ -> id

-- Quickcheck already catches exceptions, no need to do it here.
r <- quickCheck yieldProgress
args
(if verbose then QC.verbose prop else prop)
(applyTimeout $ if verbose then QC.verbose prop else prop)

qcOutput <- formatMessage $ QC.output r
let qcOutputNl =
Expand Down
2 changes: 1 addition & 1 deletion quickcheck/tasty-quickcheck.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ library
other-extensions: GeneralizedNewtypeDeriving, DeriveDataTypeable
build-depends: base >= 4.8 && < 5,
tagged < 0.9,
tasty >= 1.5 && < 1.6,
tasty >= 1.5.1 && < 1.6,
Copy link
Contributor

Choose a reason for hiding this comment

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

The change does what I need, thanks!

... but

The tasty-1.5.1 on Hackage has base <0 revision made.

If I use both core and quickcheck from the repo, then cabal-install finds an install plan.

Copy link
Collaborator Author

Choose a reason for hiding this comment

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

That's expected, I'll release tasty-1.5.1.1 (or 1.5.2) soon.

random < 1.3,
QuickCheck >= 2.10 && < 2.16,
optparse-applicative < 0.19
Expand Down
Loading