wip

Author: erikd

plutus-core/plutus-core.cabal

@@ -973,6 +973,7 @@ test-suite satint-test
   main-is:          TestSatInt.hs
   build-depends:
     , base                        >=4.9 && <5
+    , cardano-base:{testlib}      >=0.1.5
     , HUnit
     , QuickCheck
     , satint

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

@@ -8,4 +8,4 @@ import Test.QuickCheck
 
 -- | This mainly tests that the `Data` generator isn't non-terminating or too slow.
 prop_genData :: Property
-prop_genData = withMaxSuccess 800 $ \(d :: Data) -> d === deserialise (serialise d)
+prop_genData = BaseQC.withNumTests 800 $ \(d :: Data) -> d === deserialise (serialise d)

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

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

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

@@ -21,7 +21,7 @@ prop_genKindCorrect = p_genKindCorrect False
 See Note [Debugging generators that don't generate well-typed/kinded terms/types]
 and see the utility tests below when this property fails. -}
 p_genKindCorrect :: Bool -> Property
-p_genKindCorrect debug = withMaxSuccess 1000 $
+p_genKindCorrect debug = BaseQC.withNumTests 1000 $
   -- Context minimality doesn't help readability, so no shrinking here
   forAllDoc "ctx" genCtx (const []) $ \ctx ->
     -- Note, no shrinking here because shrinking relies on well-kindedness.
@@ -30,7 +30,7 @@ p_genKindCorrect debug = withMaxSuccess 1000 $
 
 -- | Check that shrinking types maintains kinds.
 prop_shrinkTypeSound :: Property
-prop_shrinkTypeSound = withMaxSuccess 500 $
+prop_shrinkTypeSound = BaseQC.withNumTests 500 $
   forAllDoc "ctx" genCtx (const []) $ \ctx ->
     forAllDoc "k,ty" (genKindAndTypeWithCtx ctx) (shrinkKindAndType ctx) $ \(k, ty) ->
       -- See discussion about the same trick in 'prop_shrinkTermSound'.
@@ -45,7 +45,7 @@ prop_shrinkTypeSound = withMaxSuccess 500 $
 
 -- | Test that shrinking a type results in a type of a smaller kind. Useful for debugging shrinking.
 prop_shrinkTypeSmallerKind :: Property
-prop_shrinkTypeSmallerKind = withMaxSuccess 3000 $
+prop_shrinkTypeSmallerKind = BaseQC.withNumTests 3000 $
   forAllDoc "k,ty" genKindAndType (shrinkKindAndType Map.empty) $ \(k, ty) ->
     assertNoCounterexamples
       [ (k', ty')
@@ -55,13 +55,13 @@ prop_shrinkTypeSmallerKind = withMaxSuccess 3000 $
 
 -- | Test that shrinking kinds generates smaller kinds.
 prop_shrinkKindSmaller :: Property
-prop_shrinkKindSmaller = withMaxSuccess 30000 $
+prop_shrinkKindSmaller = BaseQC.withNumTests 30000 $
   forAllDoc "k" arbitrary shrink $ \k ->
     assertNoCounterexamples [k' | k' <- shrink k, not $ leKind k' k]
 
 -- | Test that fixKind actually gives you something of the right kind.
 prop_fixKind :: Property
-prop_fixKind = withMaxSuccess 10000 $
+prop_fixKind = BaseQC.withNumTests 10000 $
   forAllDoc "ctx" genCtx (const []) $ \ctx ->
     forAllDoc "k,ty" genKindAndType (shrinkKindAndType ctx) $ \(k, ty) ->
       -- 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 $
 
 -- | Check that 'normalizeType' returns a normal type.
 prop_normalizedTypeIsNormal :: Property
-prop_normalizedTypeIsNormal = withMaxSuccess 1000 $
+prop_normalizedTypeIsNormal = BaseQC.withNumTests 1000 $
   forAllDoc "k,ty" genKindAndType (shrinkKindAndType Map.empty) $ \(_, ty) ->
     unless (isNormalType . unNormalized . runQuote $ normalizeType ty) $
       Left "'normalizeType' returned a non-normal type"

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

@@ -36,7 +36,7 @@ test_lets =
 test_propLets :: TestTree
 test_propLets =
   ignoreTest $ testProperty "lets" $ \letKind ->
-    withMaxSuccess 40000 $
+    BaseQC.withNumTests 40000 $
       testPassProp' @_ @_ @_ @(Provenance ())
         (Original ())
         (\t -> fmap Original t)

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

@@ -67,7 +67,7 @@ Note, the counterexamples from this property are not shrunk (see why below).
 See Note [Debugging generators that don't generate well-typed/kinded terms/types]
 and the utility properties below when this property fails. -}
 p_genTypeCorrect :: Bool -> Property
-p_genTypeCorrect debug = withMaxSuccess 200 $ do
+p_genTypeCorrect debug = BaseQC.withNumTests 200 $ do
   -- Note, we don't shrink this term here because a precondition of shrinking is that
   -- the term we are shrinking is well-typed. If it is not, the counterexample we get
   -- from shrinking will be nonsene.
@@ -77,7 +77,7 @@ p_genTypeCorrect debug = withMaxSuccess 200 $ do
 {-| Test that when we generate a fully applied term we end up
 with a well-typed term. -}
 prop_genWellTypedFullyApplied :: Property
-prop_genWellTypedFullyApplied = withMaxSuccess 50 $
+prop_genWellTypedFullyApplied = BaseQC.withNumTests 50 $
   forAllDoc "ty, tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(ty, tm) ->
     -- No shrinking here because if `genFullyApplied` is wrong then the shrinking
     -- will be wrong too. See `prop_genTypeCorrect`.
@@ -87,7 +87,7 @@ prop_genWellTypedFullyApplied = withMaxSuccess 50 $
 -- | Test that shrinking a well-typed term results in a well-typed term
 prop_shrinkTermSound :: Property
 -- The test is disabled, because it's exponential and was hanging CI.
-prop_shrinkTermSound = withMaxSuccess 0 $
+prop_shrinkTermSound = BaseQC.withNumTests 0 $
   forAllDoc "ty,tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(ty, tm) ->
     let shrinks = shrinkClosedTypedTerm (ty, tm)
      in -- While we generate well-typed terms we still need this check here for
@@ -112,7 +112,7 @@ prop_shrinkTermSound = withMaxSuccess 0 $
 
 -- | Test that `findInstantiation` results in a well-typed instantiation.
 prop_findInstantiation :: Property
-prop_findInstantiation = withMaxSuccess 1000 $
+prop_findInstantiation = BaseQC.withNumTests 1000 $
   forAllDoc "ctx" genCtx (const []) $ \ctx0 ->
     forAllDoc "ty" (genTypeWithCtx ctx0 $ Type ()) (shrinkType ctx0) $ \ty0 ->
       forAllDoc "target" (genTypeWithCtx ctx0 $ Type ()) (shrinkType ctx0) $ \target ->
@@ -149,7 +149,7 @@ prop_findInstantiation = withMaxSuccess 1000 $
 
 -- | Check what's in the leaves of the generated data
 prop_stats_leaves :: Property
-prop_stats_leaves = withMaxSuccess 10 $
+prop_stats_leaves = BaseQC.withNumTests 10 $
   -- No shrinking here because we are only collecting stats
   forAllDoc "_,tm" genTypeAndTerm_ (const []) $ \(_, tm) ->
     tabulate "leaves" (map (filter isAlpha . show . prettyReadable) $ leaves tm) $ property True
@@ -168,7 +168,7 @@ prop_stats_leaves = withMaxSuccess 10 $
 -- | Check the ratio of duplicate shrinks
 prop_stats_numShrink :: Property
 -- The test is disabled, because it's exponential and was hanging CI.
-prop_stats_numShrink = withMaxSuccess 0 $
+prop_stats_numShrink = BaseQC.withNumTests 0 $
   -- No shrinking here because we are only collecting stats
   forAllDoc "ty,tm" genTypeAndTerm_ (const []) $ \(ty, tm) ->
     let shrinks = map snd $ shrinkClosedTypedTerm (ty, tm)
@@ -181,7 +181,7 @@ prop_stats_numShrink = withMaxSuccess 0 $
 
 -- | Specific test that `inhabitType` returns well-typed things
 prop_inhabited :: Property
-prop_inhabited = withMaxSuccess 50 $
+prop_inhabited = BaseQC.withNumTests 50 $
   -- No shrinking here because if the generator
   -- generates nonsense shrinking will be nonsense.
   forAllDoc "ty,tm" (genInhab mempty) (const []) $
@@ -201,7 +201,7 @@ prop_inhabited = withMaxSuccess 50 $
 -- | Check that there are no one-step shrink loops
 prop_noTermShrinkLoops :: Property
 -- The test is disabled, because it's exponential and was hanging CI.
-prop_noTermShrinkLoops = withMaxSuccess 0
+prop_noTermShrinkLoops = BaseQC.withNumTests 0
   $
   -- Note that we need to remove x from the shrinks of x here because
   -- a counterexample to this property is otherwise guaranteed to
@@ -226,7 +226,7 @@ noStructuralErrors term =
 
 -- | Test that evaluation of well-typed terms doesn't fail with a structural error.
 prop_noStructuralErrors :: Property
-prop_noStructuralErrors = withMaxSuccess 99 $
+prop_noStructuralErrors = BaseQC.withNumTests 99 $
   forAllDoc "ty,tm" genTypeAndTerm_ shrinkClosedTypedTerm $ \(_, termPir) -> ioProperty $ do
     termUPlc <-
       fmap UPLC._progTerm . modifyError (userError . displayException) . toUPlc $

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

@@ -5,7 +5,7 @@ import PlutusIR.Parser
 import PlutusIR.Pass.Test
 import PlutusIR.Test
 import PlutusIR.Transform.Beta
-import Test.QuickCheck.Property (Property, withMaxSuccess)
+import Test.QuickCheck.Property (Property, BaseQC.withNumTests)
 import Test.Tasty
 import Test.Tasty.Extras
 
@@ -22,4 +22,4 @@ test_beta =
       ]
 
 prop_beta :: Property
-prop_beta = withMaxSuccess numTestsForPassProp $ testPassProp runQuote betaPassSC
+prop_beta = BaseQC.withNumTests numTestsForPassProp $ testPassProp runQuote betaPassSC

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

@@ -9,7 +9,7 @@ import PlutusIR.Pass.Test
 import PlutusIR.Test
 import PlutusIR.Transform.CaseOfCase qualified as CaseOfCase
 import PlutusPrelude
-import Test.QuickCheck.Property (Property, withMaxSuccess)
+import Test.QuickCheck.Property (Property, BaseQC.withNumTests)
 
 test_caseOfCase :: TestTree
 test_caseOfCase =
@@ -31,6 +31,6 @@ test_caseOfCase =
 
 prop_caseOfCase :: Property
 prop_caseOfCase =
-  withMaxSuccess numTestsForPassProp $
+  BaseQC.withNumTests numTestsForPassProp $
     testPassProp runQuote $
       \tc -> CaseOfCase.caseOfCasePassSC tc def True mempty

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

@@ -3,7 +3,7 @@ module PlutusIR.Transform.CaseReduce.Tests where
 import Data.Functor.Identity
 import PlutusIR.Pass.Test
 import PlutusIR.Transform.CaseReduce
-import Test.QuickCheck.Property (Property, withMaxSuccess)
+import Test.QuickCheck.Property (Property, BaseQC.withNumTests)
 
 prop_caseReduce :: Property
-prop_caseReduce = withMaxSuccess numTestsForPassProp $ testPassProp runIdentity caseReducePass
+prop_caseReduce = BaseQC.withNumTests numTestsForPassProp $ testPassProp runIdentity caseReducePass

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

@@ -41,7 +41,7 @@ test_deadCode =
 -- this test sometimes fails so ignoring it to make CI pass.
 typecheckRemoveDeadBindingsProp :: BuiltinSemanticsVariant DefaultFun -> Property
 typecheckRemoveDeadBindingsProp biVariant =
-  withMaxSuccess (3 * numTestsForPassProp)
+  BaseQC.withNumTests (3 * numTestsForPassProp)
     $ testPassProp
       runQuote
     $ \tc -> removeDeadBindingsPassSC tc (def {_biSemanticsVariant = biVariant})