Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

PLT-936: Add Arbitrary Data instance #4922

Merged
merged 5 commits into from
Nov 3, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions plutus-core/plutus-core.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -389,6 +389,7 @@ library plutus-core-testlib
, prettyprinter >=1.1.0.1
, prettyprinter-configurable
, QuickCheck
, quickcheck-instances
, quickcheck-transformer
, size-based
, Stream
Expand Down Expand Up @@ -466,6 +467,7 @@ test-suite plutus-ir-test
hs-source-dirs: plutus-ir/test
other-modules:
GeneratorSpec
GeneratorSpec.Builtin
GeneratorSpec.Substitution
GeneratorSpec.Types
NamesSpec
Expand All @@ -483,6 +485,7 @@ test-suite plutus-ir-test
, plutus-core ^>=1.1
, plutus-core-testlib ^>=1.1
, QuickCheck
, serialise
, tasty
, tasty-hedgehog
, tasty-quickcheck
Expand Down
4 changes: 3 additions & 1 deletion plutus-core/plutus-ir/test/GeneratorSpec.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
-- editorconfig-checker-disable-file
module GeneratorSpec where

import GeneratorSpec.Builtin
import GeneratorSpec.Substitution
import GeneratorSpec.Types

Expand All @@ -13,7 +14,8 @@ import Test.Tasty.QuickCheck
-- The default for the argument is @1@.
generators :: Int -> TestNested
generators factor = return $ testGroup "generators"
[ testProperty "prop_genKindCorrect" $ withMaxSuccess (factor*100000) (prop_genKindCorrect False)
[ testProperty "prop_genData" $ withMaxSuccess (factor*10000) prop_genData
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

plutus-ir/test is a weird place for this, no?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Particularly since the Data generator comes from PlutusCore.Generators.QuickCheck.Builtin.

, testProperty "prop_genKindCorrect" $ withMaxSuccess (factor*100000) (prop_genKindCorrect False)
, testProperty "prop_shrinkTypeSound" $ withMaxSuccess (factor*100000) prop_shrinkTypeSound
, testProperty "prop_substType" $ withMaxSuccess (factor*10000) prop_substType
, testProperty "prop_unify" $ withMaxSuccess (factor*10000) prop_unify
Expand Down
13 changes: 13 additions & 0 deletions plutus-core/plutus-ir/test/GeneratorSpec/Builtin.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@

module GeneratorSpec.Builtin where

import PlutusCore.Data
import PlutusCore.Generators.QuickCheck

import Codec.Serialise
import Test.QuickCheck

-- | This mainly tests that the `Data` generator isn't non-terminating or too slow.
prop_genData :: Property
prop_genData = forAll arbitrary $ \(d :: Data) ->
d == deserialise (serialise d)
44 changes: 42 additions & 2 deletions plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module PlutusCore.Generators.QuickCheck.Builtin where
import PlutusCore
import PlutusCore.Builtin
import PlutusCore.Data
import PlutusCore.Generators.QuickCheck.Common (genList)

import Data.ByteString (ByteString)
import Data.Coerce
Expand All @@ -21,11 +22,50 @@ import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Word
import Test.QuickCheck
import Test.QuickCheck.Instances.ByteString ()

instance Arbitrary Data where
arbitrary = error "implement me"
shrink = error "implement me"
arbitrary = sized genData

shrink = genericShrink

genData :: Int -> Gen Data
genData depth =
oneof $
[genI, genB]
<> [ genRec | depth > 1, genRec <-
[ genListData (depth `div` 2)
, genMapData (depth `div` 2)
, genConstrData (depth `div` 2)
]
]
where
genI = I <$> arbitraryBuiltin
genB = B <$> arbitraryBuiltin

genListWithMaxDepth :: Int -> (Int -> Gen a) -> Gen [a]
genListWithMaxDepth depth gen =
-- The longer the list, the smaller the elements.
frequency
[ (100, genList 0 5 (gen depth))
, (10, genList 0 50 (gen (depth `div` 2)))
, (1, genList 0 500 (gen (depth `div` 4)))
]

genListData :: Int -> Gen Data
genListData depth = List <$> genListWithMaxDepth depth genData

genMapData :: Int -> Gen Data
genMapData depth =
Map <$> genListWithMaxDepth depth (\d -> (,) <$> genData d <*> genData d)

genConstrData :: Int -> Gen Data
genConstrData depth =
Constr
<$> (fromIntegral <$> arbitrary @Word64)
<*> genListWithMaxDepth depth genData

-- | Same as 'Arbitrary' but specifically for Plutus built-in types, so that we are not tied to
-- the default implementation of the methods for a built-in type.
Expand Down
21 changes: 21 additions & 0 deletions plutus-core/testlib/PlutusCore/Generators/QuickCheck/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,8 @@ import Data.Bifunctor
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import GHC.Stack
import Test.QuickCheck.Gen (Gen)
import Test.QuickCheck.Gen qualified as Gen
import Test.QuickCheck.Modifiers (NonNegative (..))
import Test.QuickCheck.Property
import Text.Pretty
Expand Down Expand Up @@ -67,3 +69,22 @@ checkKind ctx ty kExp =
]
where
kInf = inferKind ctx ty

-- | Generate a list with the given minimum and maximum lengths.
-- It is similar to @Hedgehog.Internal.Gen.list@.
--
-- Note that @genList 0 n gen@ behaves differently than @resize n (listOf gen)@, because
--
-- @
-- resize m (genList 0 n gen) = genList 0 n (resize m gen)
-- @
--
-- whereas
--
-- @
-- resize m (resize n (listOf gen)) = resize n (listOf gen)
-- @
genList :: Int -> Int -> Gen a -> Gen [a]
genList lb ub gen = do
len <- Gen.chooseInt (lb, ub)
Gen.vectorOf len gen