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.

Sign up for GitHub

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

Jump to bottom

Ledger types testing #6618

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Ledger types testing #6618

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
b424cb7
test FaceValue
aleeusgr Oct 17, 2024
783bbf6
add OutputDatum
aleeusgr Oct 31, 2024
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
1 change: 1 addition & 0 deletions plutus-ledger-api/plutus-ledger-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -131,6 +131,7 @@ library plutus-ledger-api-testlib
PlutusLedgerApi.Test.V1.Value
PlutusLedgerApi.Test.V2.Data.EvaluationContext
PlutusLedgerApi.Test.V2.EvaluationContext
PlutusLedgerApi.Test.V2.OutputDatum
PlutusLedgerApi.Test.V3.Data.EvaluationContext
PlutusLedgerApi.Test.V3.EvaluationContext

Expand Down
3 changes: 3 additions & 0 deletions plutus-ledger-api/test/Spec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ import Spec.Interval qualified
import Spec.ScriptDecodeError qualified
import Spec.V1.Data.Value qualified as Data.Value
import Spec.V1.Value qualified as Value
import Spec.V2.OutputDatum qualified as OutputDatum
import Spec.Versions qualified

import Test.Tasty
Expand Down Expand Up @@ -136,6 +137,8 @@ tests = testGroup "plutus-ledger-api"
, Spec.CostModelParams.tests
, Spec.ContextDecoding.tests
, Value.test_Value
, Value.test_FaceValue
, OutputDatum.testOutputDatum
Copy link
Author

Choose a reason for hiding this comment

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

I get errors:

No instance for ‘Arbitrary DatumHash’                                                                            
        arising from a use of ‘arbitrary’
...
No instance for ‘Arbitrary Datum’                                                                            
        arising from a use of ‘arbitrary’

]
, testGroup "Data"
[ Spec.Data.Eval.tests
Expand Down
10 changes: 10 additions & 0 deletions plutus-ledger-api/test/Spec/V1/Value.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -122,6 +122,11 @@ test_split = testProperty "split" . scaleTestsBy 7 $ \value ->
let (valueL, valueR) = split value
in Numeric.negate valueL <> valueR <=> value

test_roundTripFaceValue :: TestTree
test_roundTripFaceValue = testProperty "unFaceValue followed by FaceValue returns the original" $
\(faceValue :: FaceValue) ->
unFaceValue (FaceValue $ unFaceValue faceValue) === unFaceValue faceValue

test_Value :: TestTree
test_Value = testGroup "Value"
[ test_laws
Expand All @@ -130,3 +135,8 @@ test_Value = testGroup "Value"
, test_shuffle
, test_split
]

test_FaceValue :: TestTree
test_FaceValue = testGroup "FaceValue"
[ test_roundTripFaceValue
]
17 changes: 17 additions & 0 deletions plutus-ledger-api/test/Spec/V2/OutputDatum.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
module Spec.V2.OutputDatum where

import PlutusLedgerApi.Test.V2.OutputDatum ()
import Test.Tasty
import Test.Tasty.QuickCheck

-- Define a test case for Arbitrary instance
arbitraryTest :: TestTree
arbitraryTest = testProperty "Arbitrary instance exists" $ \(_) ->
let _ = arbitrary :: Gen OutputDatum
in True

-- Define the main test suite
testOutputDatum :: TestTree
testOutputDatum = testGroup "OutputDatum"
[arbitraryTest
]
3 changes: 3 additions & 0 deletions plutus-ledger-api/testlib/PlutusLedgerApi/Test/V1/Value.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,9 @@ instance Arbitrary FaceValue where
, (1, FaceValue . fromIntegral <$> arbitrary @Int)
]

instance Show FaceValue where
show (FaceValue value) = show value

-- | A wrapper for satisfying an @Arbitrary a@ constraint without implementing an 'Arbitrary'
-- instance for @a@.
newtype NoArbitrary a = NoArbitrary
Expand Down
28 changes: 28 additions & 0 deletions plutus-ledger-api/testlib/PlutusLedgerApi/Test/V2/OutputDatum.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
{-# LANGUAGE LambdaCase #-}

module PlutusLedgerApi.Test.V2.OutputDatum where

import PlutusLedgerApi.V2
import Test.QuickCheck

instance Arbitrary OutputDatum where
{-# INLINEABLE arbitrary #-}
arbitrary =
oneof
[ pure NoOutputDatum
, OutputDatumHash <$> arbitrary
, OutputDatum <$> arbitrary
]
{-# INLINEABLE shrink #-}
-- We only shrink the OutputDatum case, since the others wouldn't shrink
-- anyway.
shrink = \case
OutputDatum d -> OutputDatum <$> shrink d
_ -> []

instance CoArbitrary OutputDatum where
{-# INLINEABLE coarbitrary #-}
coarbitrary = \case
NoOutputDatum -> variant (0 :: Int)
OutputDatumHash dh -> variant (1 :: Int) . coarbitrary dh
OutputDatum d -> variant (2 :: Int) . coarbitrary d