Commit 4d83212f authored by kristenk's avatar kristenk
Browse files

Print the seed before running each solver-quickcheck test.

This could help with debugging test cases that run out of memory or timeout in
CI, such as the failure in #5054.
parent 429fbc77
......@@ -603,6 +603,7 @@ executable cabal
UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils
UnitTests.Distribution.Solver.Modular.MemoryUsage
UnitTests.Distribution.Solver.Modular.QuickCheck
UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
UnitTests.Distribution.Solver.Modular.RetryLog
UnitTests.Distribution.Solver.Modular.Solver
UnitTests.Distribution.Solver.Modular.WeightedPSQ
......@@ -740,6 +741,7 @@ Test-Suite solver-quickcheck
other-modules:
UnitTests.Distribution.Solver.Modular.DSL
UnitTests.Distribution.Solver.Modular.QuickCheck
UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
build-depends:
base,
async,
......@@ -748,6 +750,8 @@ Test-Suite solver-quickcheck
containers,
deepseq >= 1.2,
hashable,
random,
tagged,
tasty >= 0.12,
tasty-quickcheck,
QuickCheck >= 2.8.2,
......
......@@ -42,6 +42,8 @@ import Distribution.Solver.Types.Variable
import Distribution.Version
import UnitTests.Distribution.Solver.Modular.DSL
import UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
( testPropertyWithSeed )
tests :: [TestTree]
tests = [
......@@ -49,7 +51,7 @@ tests = [
-- existence of a solution. It runs the solver twice, and only sets those
-- parameters on the second run. The test also applies parameters that
-- can affect the existence of a solution to both runs.
testProperty "target and goal order do not affect solvability" $
testPropertyWithSeed "target and goal order do not affect solvability" $
\test targetOrder mGoalOrder1 mGoalOrder2 indepGoals ->
let r1 = solve' mGoalOrder1 test
r2 = solve' mGoalOrder2 test { testTargets = targets2 }
......@@ -65,7 +67,7 @@ tests = [
noneReachedBackjumpLimit [r1, r2] ==>
isRight (resultPlan r1) === isRight (resultPlan r2)
, testProperty
, testPropertyWithSeed
"solvable without --independent-goals => solvable with --independent-goals" $
\test reorderGoals ->
let r1 = solve' (IndependentGoals False) test
......@@ -76,7 +78,7 @@ tests = [
noneReachedBackjumpLimit [r1, r2] ==>
isRight (resultPlan r1) `implies` isRight (resultPlan r2)
, testProperty "backjumping does not affect solvability" $
, testPropertyWithSeed "backjumping does not affect solvability" $
\test reorderGoals indepGoals ->
let r1 = solve' (EnableBackjumping True) test
r2 = solve' (EnableBackjumping False) test
......@@ -93,7 +95,7 @@ tests = [
-- different solutions and cause the test to fail.
-- TODO: Find a faster way to randomly sort goals, and then use a random
-- goal order in this test.
, testProperty
, testPropertyWithSeed
"backjumping does not affect the result (with static goal order)" $
\test reorderGoals indepGoals ->
let r1 = solve' (EnableBackjumping True) test
......
module UnitTests.Distribution.Solver.Modular.QuickCheck.Utils (
testPropertyWithSeed
) where
import Data.Tagged (Tagged, retag)
import System.Random (getStdRandom, random)
import Test.Tasty (TestTree)
import Test.Tasty.Options (OptionDescription, lookupOption, setOption)
import Test.Tasty.Providers (IsTest (..), singleTest)
import Test.Tasty.QuickCheck
( QC (..), QuickCheckReplay (..), Testable, property )
import Distribution.Simple.Utils
import Distribution.Verbosity
-- | Create a QuickCheck test that prints the seed before testing the property.
-- The seed can be useful for debugging non-terminating test cases. This is
-- related to https://github.com/feuerbach/tasty/issues/86.
testPropertyWithSeed :: Testable a => String -> a -> TestTree
testPropertyWithSeed name = singleTest name . QCWithSeed . QC . property
newtype QCWithSeed = QCWithSeed QC
instance IsTest QCWithSeed where
testOptions = retag (testOptions :: Tagged QC [OptionDescription])
run options (QCWithSeed test) progress = do
replay <- case lookupOption options of
QuickCheckReplay (Just override) -> return override
QuickCheckReplay Nothing -> getStdRandom random
notice normal $ "Using --quickcheck-replay=" ++ show replay
run (setOption (QuickCheckReplay (Just replay)) options) test progress
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment