cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs

   1 module UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
   2   ( testPropertyWithSeed
   3   ) where
   4
   5 import Data.Tagged (Tagged, retag)
   6 import System.Random (getStdRandom, random)
   7
   8 import Test.Tasty (TestTree)
   9 import Test.Tasty.Options (OptionDescription, lookupOption, setOption)
  10 import Test.Tasty.Providers (IsTest (..), singleTest)
  11 import Test.Tasty.QuickCheck
  12   ( QC (..)
  13   , QuickCheckReplay (..)
  14   , Testable
  15   , property
  16   )
  17
  18 import Distribution.Simple.Utils
  19 import Distribution.Verbosity
  20
  21 -- | Create a QuickCheck test that prints the seed before testing the property.
  22 -- The seed can be useful for debugging non-terminating test cases. This is
  23 -- related to https://github.com/feuerbach/tasty/issues/86.
  24 testPropertyWithSeed :: Testable a => String -> a -> TestTree
  25 testPropertyWithSeed name = singleTest name . QCWithSeed . QC . property
  26
  27 newtype QCWithSeed = QCWithSeed QC
  28
  29 instance IsTest QCWithSeed where
  30   testOptions = retag (testOptions :: Tagged QC [OptionDescription])
  31
  32   run options (QCWithSeed test) progress = do
  33     replay <- case lookupOption options of
  34       QuickCheckReplayLegacy override -> return override
  35       _ -> getStdRandom random
  36     notice normal $ "Using --quickcheck-replay=" ++ show replay
  37     run (setOption (QuickCheckReplayLegacy replay) options) test progress