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

Ledger types testing #6618

Closed
wants to merge 2 commits into from
Closed

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
Contributor 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’

Copy link
Contributor

Choose a reason for hiding this comment

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

Not here though, in OutputDatum.

]
, 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
Copy link
Contributor

Choose a reason for hiding this comment

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

That's a completely useless test unfortunately, this property is guaranteed by GHC.


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
Copy link
Contributor

Choose a reason for hiding this comment

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

You could just derive it, but OK.


-- | 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
Copy link
Contributor

Choose a reason for hiding this comment

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

Yeah, that relies on a whole lot other Arbitrary instances existing.

]
{-# 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