Skip to content

Commit 328ef97

Browse files
committed
withMaxSuccess
1 parent e254b60 commit 328ef97

31 files changed

Lines changed: 93 additions & 93 deletions

File tree

plutus-core/plutus-core.cabal

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1032,7 +1032,7 @@ test-suite index-envs-test
10321032
, base >=4.9 && <5
10331033
, index-envs
10341034
, nonempty-vector
1035-
, QuickCheck
1035+
, QuickCheck >=2.18
10361036
, quickcheck-instances
10371037
, tasty
10381038
, tasty-quickcheck
@@ -1139,7 +1139,7 @@ test-suite flat-test
11391139
, containers
11401140
, deepseq
11411141
, plutus-core:flat
1142-
, QuickCheck
1142+
, QuickCheck >=2.18
11431143
, quickcheck-text
11441144
, tasty
11451145
, tasty-golden

plutus-core/plutus-core/test/Generators/QuickCheck/Utils.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,14 +21,14 @@ test_multiSplitSound =
2121
, ("multiSplit0", multiSplit0 0.1)
2222
]
2323
pure . testProperty name $ \(xs :: [Int]) ->
24-
withMaxSuccess 10000 . forAll (split xs) $ \aSplit ->
24+
withNumTests 10000 . forAll (split xs) $ \aSplit ->
2525
xs === concat aSplit
2626

2727
-- | Show the distribution of lists generated by a split function for a list of the given length.
2828
test_listDistribution :: Int -> ([()] -> Gen [[()]]) -> Int -> TestTree
2929
test_listDistribution numRuns split n =
3030
testProperty ("for a list of length " ++ show n) $
31-
withMaxSuccess numRuns . forAll (split $ replicate n ()) $ \aSplit ->
31+
withNumTests numRuns . forAll (split $ replicate n ()) $ \aSplit ->
3232
label (show $ map length aSplit) True
3333

3434
-- | Count the number of 'I' and 'B' nodes in a 'Data' object.
@@ -48,7 +48,7 @@ length of the spine. Ensures that the 'Data' generator is not exponential in 'B'
4848
test_arbitraryDataExpectedLeafs :: TestTree
4949
test_arbitraryDataExpectedLeafs =
5050
testProperty "'arbitrary @Data' has the expected number of 'B' and 'I' leaves" $
51-
withMaxSuccess 1000 . mapSize (* 5) $ \spine ->
51+
withNumTests 1000 . mapSize (* 5) $ \spine ->
5252
forAll (genDataFromSpine spine) $ \dat ->
5353
countIandBs dat === length spine
5454

plutus-core/plutus-ir/test/PlutusCore/Generators/QuickCheck/BuiltinsTests.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,4 +8,4 @@ import Test.QuickCheck
88

99
-- | This mainly tests that the `Data` generator isn't non-terminating or too slow.
1010
prop_genData :: Property
11-
prop_genData = withMaxSuccess 800 $ \(d :: Data) -> d === deserialise (serialise d)
11+
prop_genData = withNumTests 800 $ \(d :: Data) -> d === deserialise (serialise d)

plutus-core/plutus-ir/test/PlutusCore/Generators/QuickCheck/SubstitutionTests.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ The statistics at the time this comment was written are as follows:
3838
So we don't get great coverage, but given that it takes a few seconds to generate dozens of
3939
thousands of (non-filtered) test cases, we do still get some reasonable coverage in the end. -}
4040
prop_unify :: Property
41-
prop_unify = withMaxSuccess 500 $
41+
prop_unify = withNumTests 500 $
4242
forAllDoc "n" arbitrary shrink $ \(NonNegative n) ->
4343
forAllDoc "nSub" (choose (0, n)) shrink $ \nSub ->
4444
-- See Note [Chaotic Good fresh name generation].
@@ -89,7 +89,7 @@ prop_unifyRename =
8989
{-| Check that substitution eliminates from the type all free occurrences of variables present in
9090
the domain of the substitution. -}
9191
prop_substType :: Property
92-
prop_substType = withMaxSuccess 1000 $
92+
prop_substType = withNumTests 1000 $
9393
-- No shrinking because every nested shrink makes properties harder to shrink (because you'd need
9494
-- to regenerate the stuff that depends on the context, meaning you don't have the same
9595
-- counterexample as you did before) and context minimality doesn't help readability very much.

plutus-core/plutus-ir/test/PlutusCore/Generators/QuickCheck/TypesTests.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ prop_genKindCorrect = p_genKindCorrect False
2121
See Note [Debugging generators that don't generate well-typed/kinded terms/types]
2222
and see the utility tests below when this property fails. -}
2323
p_genKindCorrect :: Bool -> Property
24-
p_genKindCorrect debug = withMaxSuccess 1000 $
24+
p_genKindCorrect debug = withNumTests 1000 $
2525
-- Context minimality doesn't help readability, so no shrinking here
2626
forAllDoc "ctx" genCtx (const []) $ \ctx ->
2727
-- Note, no shrinking here because shrinking relies on well-kindedness.
@@ -30,7 +30,7 @@ p_genKindCorrect debug = withMaxSuccess 1000 $
3030

3131
-- | Check that shrinking types maintains kinds.
3232
prop_shrinkTypeSound :: Property
33-
prop_shrinkTypeSound = withMaxSuccess 500 $
33+
prop_shrinkTypeSound = withNumTests 500 $
3434
forAllDoc "ctx" genCtx (const []) $ \ctx ->
3535
forAllDoc "k,ty" (genKindAndTypeWithCtx ctx) (shrinkKindAndType ctx) $ \(k, ty) ->
3636
-- See discussion about the same trick in 'prop_shrinkTermSound'.
@@ -45,7 +45,7 @@ prop_shrinkTypeSound = withMaxSuccess 500 $
4545

4646
-- | Test that shrinking a type results in a type of a smaller kind. Useful for debugging shrinking.
4747
prop_shrinkTypeSmallerKind :: Property
48-
prop_shrinkTypeSmallerKind = withMaxSuccess 3000 $
48+
prop_shrinkTypeSmallerKind = withNumTests 3000 $
4949
forAllDoc "k,ty" genKindAndType (shrinkKindAndType Map.empty) $ \(k, ty) ->
5050
assertNoCounterexamples
5151
[ (k', ty')
@@ -55,13 +55,13 @@ prop_shrinkTypeSmallerKind = withMaxSuccess 3000 $
5555

5656
-- | Test that shrinking kinds generates smaller kinds.
5757
prop_shrinkKindSmaller :: Property
58-
prop_shrinkKindSmaller = withMaxSuccess 30000 $
58+
prop_shrinkKindSmaller = withNumTests 30000 $
5959
forAllDoc "k" arbitrary shrink $ \k ->
6060
assertNoCounterexamples [k' | k' <- shrink k, not $ leKind k' k]
6161

6262
-- | Test that fixKind actually gives you something of the right kind.
6363
prop_fixKind :: Property
64-
prop_fixKind = withMaxSuccess 10000 $
64+
prop_fixKind = withNumTests 10000 $
6565
forAllDoc "ctx" genCtx (const []) $ \ctx ->
6666
forAllDoc "k,ty" genKindAndType (shrinkKindAndType ctx) $ \(k, ty) ->
6767
-- Note, fixKind only works on smaller kinds, so we use shrink to get a definitely smaller kind
@@ -74,7 +74,7 @@ prop_fixKind = withMaxSuccess 10000 $
7474

7575
-- | Check that 'normalizeType' returns a normal type.
7676
prop_normalizedTypeIsNormal :: Property
77-
prop_normalizedTypeIsNormal = withMaxSuccess 1000 $
77+
prop_normalizedTypeIsNormal = withNumTests 1000 $
7878
forAllDoc "k,ty" genKindAndType (shrinkKindAndType Map.empty) $ \(_, ty) ->
7979
unless (isNormalType . unNormalized . runQuote $ normalizeType ty) $
8080
Left "'normalizeType' returned a non-normal type"

plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/Tests.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ test_lets =
3636
test_propLets :: TestTree
3737
test_propLets =
3838
ignoreTest $ testProperty "lets" $ \letKind ->
39-
withMaxSuccess 40000 $
39+
withNumTests 40000 $
4040
testPassProp' @_ @_ @_ @(Provenance ())
4141
(Original ())
4242
(\t -> fmap Original t)

plutus-core/plutus-ir/test/PlutusIR/Generators/QuickCheck/Tests.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ Note, the counterexamples from this property are not shrunk (see why below).
6767
See Note [Debugging generators that don't generate well-typed/kinded terms/types]
6868
and the utility properties below when this property fails. -}
6969
p_genTypeCorrect :: Bool -> Property
70-
p_genTypeCorrect debug = withMaxSuccess 200 $ do
70+
p_genTypeCorrect debug = withNumTests 200 $ do
7171
-- Note, we don't shrink this term here because a precondition of shrinking is that
7272
-- the term we are shrinking is well-typed. If it is not, the counterexample we get
7373
-- from shrinking will be nonsene.
@@ -77,7 +77,7 @@ p_genTypeCorrect debug = withMaxSuccess 200 $ do
7777
{-| Test that when we generate a fully applied term we end up
7878
with a well-typed term. -}
7979
prop_genWellTypedFullyApplied :: Property
80-
prop_genWellTypedFullyApplied = withMaxSuccess 50 $
80+
prop_genWellTypedFullyApplied = withNumTests 50 $
8181
forAllDoc "ty, tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(ty, tm) ->
8282
-- No shrinking here because if `genFullyApplied` is wrong then the shrinking
8383
-- will be wrong too. See `prop_genTypeCorrect`.
@@ -87,7 +87,7 @@ prop_genWellTypedFullyApplied = withMaxSuccess 50 $
8787
-- | Test that shrinking a well-typed term results in a well-typed term
8888
prop_shrinkTermSound :: Property
8989
-- The test is disabled, because it's exponential and was hanging CI.
90-
prop_shrinkTermSound = withMaxSuccess 0 $
90+
prop_shrinkTermSound = withNumTests 0 $
9191
forAllDoc "ty,tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(ty, tm) ->
9292
let shrinks = shrinkClosedTypedTerm (ty, tm)
9393
in -- While we generate well-typed terms we still need this check here for
@@ -112,7 +112,7 @@ prop_shrinkTermSound = withMaxSuccess 0 $
112112

113113
-- | Test that `findInstantiation` results in a well-typed instantiation.
114114
prop_findInstantiation :: Property
115-
prop_findInstantiation = withMaxSuccess 1000 $
115+
prop_findInstantiation = withNumTests 1000 $
116116
forAllDoc "ctx" genCtx (const []) $ \ctx0 ->
117117
forAllDoc "ty" (genTypeWithCtx ctx0 $ Type ()) (shrinkType ctx0) $ \ty0 ->
118118
forAllDoc "target" (genTypeWithCtx ctx0 $ Type ()) (shrinkType ctx0) $ \target ->
@@ -149,7 +149,7 @@ prop_findInstantiation = withMaxSuccess 1000 $
149149

150150
-- | Check what's in the leaves of the generated data
151151
prop_stats_leaves :: Property
152-
prop_stats_leaves = withMaxSuccess 10 $
152+
prop_stats_leaves = withNumTests 10 $
153153
-- No shrinking here because we are only collecting stats
154154
forAllDoc "_,tm" genTypeAndTerm_ (const []) $ \(_, tm) ->
155155
tabulate "leaves" (map (filter isAlpha . show . prettyReadable) $ leaves tm) $ property True
@@ -168,7 +168,7 @@ prop_stats_leaves = withMaxSuccess 10 $
168168
-- | Check the ratio of duplicate shrinks
169169
prop_stats_numShrink :: Property
170170
-- The test is disabled, because it's exponential and was hanging CI.
171-
prop_stats_numShrink = withMaxSuccess 0 $
171+
prop_stats_numShrink = withNumTests 0 $
172172
-- No shrinking here because we are only collecting stats
173173
forAllDoc "ty,tm" genTypeAndTerm_ (const []) $ \(ty, tm) ->
174174
let shrinks = map snd $ shrinkClosedTypedTerm (ty, tm)
@@ -181,7 +181,7 @@ prop_stats_numShrink = withMaxSuccess 0 $
181181

182182
-- | Specific test that `inhabitType` returns well-typed things
183183
prop_inhabited :: Property
184-
prop_inhabited = withMaxSuccess 50 $
184+
prop_inhabited = withNumTests 50 $
185185
-- No shrinking here because if the generator
186186
-- generates nonsense shrinking will be nonsense.
187187
forAllDoc "ty,tm" (genInhab mempty) (const []) $
@@ -201,7 +201,7 @@ prop_inhabited = withMaxSuccess 50 $
201201
-- | Check that there are no one-step shrink loops
202202
prop_noTermShrinkLoops :: Property
203203
-- The test is disabled, because it's exponential and was hanging CI.
204-
prop_noTermShrinkLoops = withMaxSuccess 0
204+
prop_noTermShrinkLoops = withNumTests 0
205205
$
206206
-- Note that we need to remove x from the shrinks of x here because
207207
-- a counterexample to this property is otherwise guaranteed to
@@ -226,7 +226,7 @@ noStructuralErrors term =
226226

227227
-- | Test that evaluation of well-typed terms doesn't fail with a structural error.
228228
prop_noStructuralErrors :: Property
229-
prop_noStructuralErrors = withMaxSuccess 99 $
229+
prop_noStructuralErrors = withNumTests 99 $
230230
forAllDoc "ty,tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(_, termPir) -> ioProperty $ do
231231
termUPlc <-
232232
fmap UPLC._progTerm . modifyError (userError . displayException) . toUPlc $

plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/Tests.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ import PlutusIR.Parser
55
import PlutusIR.Pass.Test
66
import PlutusIR.Test
77
import PlutusIR.Transform.Beta
8-
import Test.QuickCheck.Property (Property, withMaxSuccess)
8+
import Test.QuickCheck.Property (Property, withNumTests)
99
import Test.Tasty
1010
import Test.Tasty.Extras
1111

@@ -22,4 +22,4 @@ test_beta =
2222
]
2323

2424
prop_beta :: Property
25-
prop_beta = withMaxSuccess numTestsForPassProp $ testPassProp runQuote betaPassSC
25+
prop_beta = withNumTests numTestsForPassProp $ testPassProp runQuote betaPassSC

plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/Tests.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import PlutusIR.Pass.Test
99
import PlutusIR.Test
1010
import PlutusIR.Transform.CaseOfCase qualified as CaseOfCase
1111
import PlutusPrelude
12-
import Test.QuickCheck.Property (Property, withMaxSuccess)
12+
import Test.QuickCheck.Property (Property, withNumTests)
1313

1414
test_caseOfCase :: TestTree
1515
test_caseOfCase =
@@ -31,6 +31,6 @@ test_caseOfCase =
3131

3232
prop_caseOfCase :: Property
3333
prop_caseOfCase =
34-
withMaxSuccess numTestsForPassProp $
34+
withNumTests numTestsForPassProp $
3535
testPassProp runQuote $
3636
\tc -> CaseOfCase.caseOfCasePassSC tc def True mempty

plutus-core/plutus-ir/test/PlutusIR/Transform/CaseReduce/Tests.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ module PlutusIR.Transform.CaseReduce.Tests where
33
import Data.Functor.Identity
44
import PlutusIR.Pass.Test
55
import PlutusIR.Transform.CaseReduce
6-
import Test.QuickCheck.Property (Property, withMaxSuccess)
6+
import Test.QuickCheck.Property (Property, withNumTests)
77

88
prop_caseReduce :: Property
9-
prop_caseReduce = withMaxSuccess numTestsForPassProp $ testPassProp runIdentity caseReducePass
9+
prop_caseReduce = withNumTests numTestsForPassProp $ testPassProp runIdentity caseReducePass

0 commit comments

Comments
 (0)