diff --git a/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs b/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs index df2e40a088a..3a8d3972773 100644 --- a/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs +++ b/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs @@ -65,34 +65,56 @@ instance for 'Int64' does: For this reason we use 'Int64' when dealing with QuickCheck. -} --- | A list of ranges: @[(0, 10), (11, 100), (101, 1000), ... (10^n + 1, high)]@ when --- @base = 10@. -magnitudesPositive :: Integral a => a -> a -> [(a, a)] -magnitudesPositive base high = +nextInterestingBound :: Integer -> Integer +nextInterestingBound 1 = 127 +nextInterestingBound x = (x + 1) ^ (2 :: Int) * 2 - 1 + +highInterestingBound :: Integer +highInterestingBound = toInteger (maxBound :: Int64) * 16 + +-- | A list of ranges. +-- +-- >>> import Data.Int +-- >>> magnitudesPositive (* 10) (toInteger (maxBound :: Int16)) +-- [(1,10),(11,100),(101,1000),(1001,10000),(10001,32767)] +-- +-- >>> import Data.Int +-- >>> magnitudesPositive nextInterestingBound (toInteger (maxBound :: Int64)) +-- [(1,127),(128,32767),(32768,2147483647),(2147483648,9223372036854775807)] +magnitudesPositive :: (Integer -> Integer) -> Integer -> [(Integer, Integer)] +magnitudesPositive next high = zipWith (\lo hi -> (lo + 1, hi)) borders (tail borders) where - preborders = tail . takeWhile (< high `div` base) $ iterate (* base) 1 - borders = -1 : preborders ++ [last preborders * base, high] - --- | Like 'chooseBoundedIntegral', but doesn't require the 'Bounded' constraint (and hence is slower --- for 'Word64' and 'Int64'). -chooseIntegral :: Integral a => (a, a) -> Gen a -chooseIntegral (lo, hi) = fromInteger <$> chooseInteger (toInteger lo, toInteger hi) - --- | Generate asymptotically greater positive numbers with exponentially lower chance. -arbitraryPositive :: Integral a => a -> a -> Gen a -arbitraryPositive base high = - frequency . zip freqs . reverse . map chooseIntegral $ magnitudesPositive base high - where - freqs = map floor $ iterate (* 1.3) (2 :: Double) + preborders = tail . takeWhile (\x -> next x < high) $ iterate next 1 + borders = 0 : preborders ++ [next $ last preborders, high] + +chooseIntegerPreferEnds :: (Integer, Integer) -> Gen Integer +chooseIntegerPreferEnds (lo, hi) + | hi - lo < 20 = chooseInteger (lo, hi) + | otherwise = frequency $ concat + [ zip (80 : [9, 8.. 1]) $ map pure [lo..] + , zip (80 : [9, 8.. 1]) $ map pure [hi, hi - 1] + , [(200, chooseInteger (lo + 10, hi - 10))] + ] --- | Generate asymptotically greater negative numbers with exponentially lower chance. -arbitraryNegative :: Integral a => a -> a -> Gen a -arbitraryNegative base high = negate <$> arbitraryPositive base high +arbitraryPositive :: (Integer -> Integer) -> Integer -> Gen Integer +arbitraryPositive next high = frequency . zip freqs $ map chooseIntegerPreferEnds magnitudes where + magnitudes = magnitudesPositive next high + prefreqs = map floor $ iterate (* 1.1) (100 :: Double) + freqs = concat + [ reverse (take (length magnitudes `div` 2) prefreqs) + , map (floor . (/ (1.5 :: Double)) . fromIntegral) prefreqs + ] --- | Generate asymptotically greater numbers with exponentially lower chance. -arbitrarySigned :: Integral a => a -> a -> Gen a -arbitrarySigned base high = oneof [arbitraryPositive base high, arbitraryNegative base high] +arbitraryNegative :: (Integer -> Integer) -> Integer -> Gen Integer +arbitraryNegative next high = negate <$> arbitraryPositive next high + +arbitrarySigned :: (Integer -> Integer) -> Integer -> Gen Integer +arbitrarySigned next high = frequency + [ (48, arbitraryNegative next high) + , (4, pure 0) + , (48, arbitraryPositive next high) + ] -- | Same as 'shrinkIntegral' except includes the square root of the given number (or of its -- negative if the number is negative, in which case the square root is negated too). We need the @@ -116,11 +138,8 @@ shrinkIntegralFast x = concat ] instance ArbitraryBuiltin Integer where - arbitraryBuiltin = frequency - [ (4, arbitrary @Integer) - -- See Note [QuickCheck and integral types]. - , (1, fromIntegral <$> arbitrarySigned 10 (maxBound :: Int64)) - ] + -- See Note [QuickCheck and integral types]. + arbitraryBuiltin = arbitrarySigned nextInterestingBound highInterestingBound where shrinkBuiltin = shrinkIntegralFast -- | diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Costing.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Costing.hs index 572540b2ecc..7f71a0f81ba 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Costing.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Costing.hs @@ -55,7 +55,7 @@ toExBudgetList = NonEmpty . go where magnitudes :: [(SatInt, SatInt)] magnitudes = map (bimap fromInteger fromInteger) - . magnitudesPositive 10 + . magnitudesPositive (* 10) $ fromSatInt (maxBound :: SatInt) -- | Return the range (in the sense of 'magnitudes') in which the given 'SatInt' belongs. E.g. diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs index f1585551781..831ddec237c 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs @@ -14,7 +14,19 @@ module Evaluation.Builtins.Definition ( test_definition ) where +import PlutusPrelude + +import Evaluation.Builtins.Bitwise qualified as Bitwise +import Evaluation.Builtins.BLS12_381 (test_BLS12_381) +import Evaluation.Builtins.Common +import Evaluation.Builtins.Conversion qualified as Conversion +import Evaluation.Builtins.Laws qualified as Laws +import Evaluation.Builtins.SignatureVerification (ecdsaSecp256k1Prop, ed25519_VariantAProp, + ed25519_VariantBProp, ed25519_VariantCProp, + schnorrSecp256k1Prop) + import PlutusCore hiding (Constr) +import PlutusCore qualified as PLC import PlutusCore.Builtin import PlutusCore.Compiler.Erase (eraseTerm) import PlutusCore.Data @@ -22,17 +34,12 @@ import PlutusCore.Default import PlutusCore.Evaluation.Machine.ExBudget import PlutusCore.Evaluation.Machine.ExBudgetingDefaults import PlutusCore.Evaluation.Machine.MachineParameters +import PlutusCore.Examples.Builtins +import PlutusCore.Examples.Data.Data import PlutusCore.Generators.Hedgehog.Interesting +import PlutusCore.Generators.QuickCheck.Builtin import PlutusCore.MkPlc hiding (error) import PlutusCore.Pretty -import PlutusPrelude -import UntypedPlutusCore.Evaluation.Machine.Cek - -import Evaluation.Builtins.Bitwise qualified as Bitwise -import Hedgehog hiding (Opaque, Size, Var) -import PlutusCore qualified as PLC -import PlutusCore.Examples.Builtins -import PlutusCore.Examples.Data.Data import PlutusCore.StdLib.Data.Bool import PlutusCore.StdLib.Data.Data import PlutusCore.StdLib.Data.Function qualified as Plc @@ -42,20 +49,17 @@ import PlutusCore.StdLib.Data.Pair import PlutusCore.StdLib.Data.ScottList qualified as Scott import PlutusCore.StdLib.Data.ScottUnit qualified as Scott import PlutusCore.StdLib.Data.Unit +import UntypedPlutusCore.Evaluation.Machine.Cek import Control.Exception +import Data.Bifunctor (bimap) import Data.ByteString (ByteString, pack) import Data.DList qualified as DList +import Data.List (find) import Data.Proxy import Data.String (IsString (fromString)) import Data.Text (Text) -import Evaluation.Builtins.BLS12_381 (test_BLS12_381) -import Evaluation.Builtins.Common -import Evaluation.Builtins.Conversion qualified as Conversion -import Evaluation.Builtins.Laws qualified as Laws -import Evaluation.Builtins.SignatureVerification (ecdsaSecp256k1Prop, ed25519_VariantAProp, - ed25519_VariantBProp, ed25519_VariantCProp, - schnorrSecp256k1Prop) +import Hedgehog hiding (Opaque, Size, Var) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Prettyprinter (vsep) @@ -63,6 +67,7 @@ import Test.Tasty import Test.Tasty.Extras import Test.Tasty.Hedgehog import Test.Tasty.HUnit +import Test.Tasty.QuickCheck qualified as QC type DefaultFunExt = Either DefaultFun ExtensionFun @@ -85,6 +90,24 @@ defaultBuiltinCostModelExt = (defaultBuiltinCostModelForTesting, ()) semantics variant? -} +test_IntegerDistribution :: TestTree +test_IntegerDistribution = + QC.testProperty "distribution of 'Integer' constants" . QC.withMaxSuccess 10000 $ + \(AsArbitraryBuiltin i) -> + let magnitudes = magnitudesPositive nextInterestingBound highInterestingBound + (low, high) = + maybe (error $ "Panic: unknown integer") (bimap (* signum i) (* signum i)) $ + find ((>= abs i) . snd) magnitudes + bounds = map snd magnitudes + isInteresting = i `elem` (0 : bounds ++ map succ bounds) + in (if i /= 0 + then QC.label $ "(" ++ show low ++ ", " ++ show high ++ ")" + else QC.property) + ((if isInteresting + then QC.label $ show i + else QC.property) + True) + -- | Check that the 'Factorial' builtin computes to the same thing as factorial defined in PLC -- itself. test_Factorial :: TestTree @@ -1053,7 +1076,8 @@ test_Logical = test_definition :: TestTree test_definition = testGroup "definition" - [ test_Factorial + [ test_IntegerDistribution + , test_Factorial , test_ForallFortyTwo , test_Const , test_Id