Skip to content

Commit ff6ae4f

Browse files
neilmayhewneilmayhew
committed
Remove tasty from cardano-ledger-test
benchProperty uses a tasty-based function from shelley so tasty can't be eliminated from it yet
1 parent 0cf935c commit ff6ae4f

File tree

14 files changed

+225
-292
lines changed

14 files changed

+225
-292
lines changed

‎libs/cardano-ledger-test/cardano-ledger-test.cabal‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -113,9 +113,6 @@ library
113113
prettyprinter,
114114
random,
115115
small-steps:{small-steps, testlib},
116-
tasty,
117-
tasty-hunit,
118-
tasty-quickcheck,
119116
text,
120117
time,
121118
transformers,
@@ -143,7 +140,6 @@ test-suite cardano-ledger-test
143140
base,
144141
cardano-ledger-core:testlib,
145142
cardano-ledger-test,
146-
tasty,
147143

148144
benchmark bench
149145
type: exitcode-stdio-1.0

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoAPI.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ import qualified Data.Map.Strict as Map
4949
import qualified Data.Set as Set
5050
import Lens.Micro ((&), (.~))
5151
import qualified PlutusLedgerApi.V1 as PV1
52+
import Test.Cardano.Ledger.Common
5253
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
5354
import Test.Cardano.Ledger.Examples.STSTestUtils (
5455
EraModel (..),
@@ -63,12 +64,12 @@ import Test.Cardano.Ledger.Generic.Instances ()
6364
import Test.Cardano.Ledger.Generic.Proof (AlonzoEra, Reflect (..))
6465
import Test.Cardano.Ledger.Generic.TxGen ()
6566
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
66-
import Test.Tasty (TestTree, testGroup)
67-
import Test.Tasty.HUnit (Assertion, testCase, (@?=))
6867

69-
tests :: TestTree
68+
tests :: Spec
7069
tests =
71-
testGroup "Alonzo API" [testCase "estimateMinFee" $ testEstimateMinFee @AlonzoEra]
70+
describe "Alonzo API" $ do
71+
it "estimateMinFee" $ do
72+
testEstimateMinFee @AlonzoEra
7273

7374
testEstimateMinFee ::
7475
forall era.
@@ -77,15 +78,15 @@ testEstimateMinFee ::
7778
, AlonzoEraTxBody era
7879
, EraModel era
7980
) =>
80-
Assertion
81+
Expectation
8182
testEstimateMinFee =
8283
estimateMinFeeTx @era
8384
pparams
8485
validatingTxNoWits
8586
1
8687
0
8788
0
88-
@?= alonzoMinFeeTx pparams validatingTx
89+
`shouldBe` alonzoMinFeeTx pparams validatingTx
8990
where
9091
pparams =
9192
defaultPPs emptyPParams

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs‎

Lines changed: 16 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -69,9 +69,9 @@ import Data.Maybe (fromJust)
6969
import qualified Data.Sequence.Strict as SSeq
7070
import qualified Data.Sequence.Strict as StrictSeq
7171
import qualified Data.Set as Set
72-
import Data.TreeDiff (ToExpr)
7372
import Lens.Micro ((&), (.~))
7473
import qualified PlutusLedgerApi.V1 as PV1
74+
import Test.Cardano.Ledger.Common
7575
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
7676
import Test.Cardano.Ledger.Era (registerTestAccount)
7777
import Test.Cardano.Ledger.Examples.STSTestUtils (
@@ -99,23 +99,19 @@ import Test.Cardano.Ledger.Shelley.Utils (
9999
mkVRFKeyPair,
100100
)
101101
import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
102-
import Test.Tasty (TestTree, testGroup)
103-
import Test.Tasty.HUnit (testCase)
104102

105103
forge :: forall era. EraScript era => Integer -> Script era -> MultiAsset
106104
forge n s = MultiAsset $ Map.singleton pid (Map.singleton an n)
107105
where
108106
pid = PolicyID (hashScript @era s)
109107
an = AssetName "an"
110108

111-
tests :: TestTree
109+
tests :: Spec
112110
tests =
113-
testGroup
114-
"Generic Tests, testing Alonzo PredicateFailures, in postAlonzo eras."
115-
[ alonzoBBODYexamplesP Alonzo
116-
, alonzoBBODYexamplesP Babbage
117-
, alonzoBBODYexamplesP Conway
118-
]
111+
describe "Generic Tests, testing Alonzo PredicateFailures, in postAlonzo eras" $ do
112+
alonzoBBODYexamplesP Alonzo
113+
alonzoBBODYexamplesP Babbage
114+
alonzoBBODYexamplesP Conway
119115

120116
alonzoBBODYexamplesP ::
121117
forall era.
@@ -134,19 +130,17 @@ alonzoBBODYexamplesP ::
134130
, EraPlutusTxInfo PlutusV1 era
135131
) =>
136132
Proof era ->
137-
TestTree
133+
Spec
138134
alonzoBBODYexamplesP proof =
139-
testGroup
140-
(show proof ++ " BBODY examples")
141-
[ testCase "eight plutus scripts cases" $
142-
runSTS @"BBODY" @era
143-
(TRC (BbodyEnv @era defaultPParams def, initialBBodyState @era initUTxO, testAlonzoBlock @era))
144-
(genericCont "" $ Right testBBodyState)
145-
, testCase "block with bad pool md hash in tx" $
146-
runSTS @"BBODY" @era
147-
(TRC (BbodyEnv @era defaultPParams def, initialBBodyState initUTxO, testAlonzoBadPMDHBlock))
148-
(genericCont "" . Left . pure $ makeTooBig @era)
149-
]
135+
describe (show proof ++ " BBODY examples") $ do
136+
it "eight plutus scripts cases" $
137+
runSTS @"BBODY" @era
138+
(TRC (BbodyEnv @era defaultPParams def, initialBBodyState @era initUTxO, testAlonzoBlock @era))
139+
(genericCont "" $ Right testBBodyState)
140+
it "block with bad pool md hash in tx" $
141+
runSTS @"BBODY" @era
142+
(TRC (BbodyEnv @era defaultPParams def, initialBBodyState initUTxO, testAlonzoBadPMDHBlock))
143+
(genericCont "" . Left . pure $ makeTooBig @era)
150144

151145
initialBBodyState ::
152146
forall era.

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoCollectInputs.hs‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
5858
import Lens.Micro
5959
import qualified PlutusLedgerApi.V1 as PV1
6060
import Test.Cardano.Ledger.Alonzo.Scripts (alwaysSucceeds)
61+
import Test.Cardano.Ledger.Common
6162
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
6263
import Test.Cardano.Ledger.Examples.AlonzoAPI (defaultPParams)
6364
import Test.Cardano.Ledger.Examples.STSTestUtils (
@@ -73,23 +74,21 @@ import Test.Cardano.Ledger.Plutus (
7374
alwaysSucceedsPlutus,
7475
zeroTestingCostModel,
7576
)
76-
import Test.Tasty (TestTree)
77-
import Test.Tasty.HUnit (Assertion, testCase, (@?=))
7877

79-
tests :: TestTree
78+
tests :: Spec
8079
tests =
81-
testCase
80+
it
8281
"collectTwoPhaseScriptInputs output order"
8382
collectTwoPhaseScriptInputsOutputOrdering
8483

8584
-- Test for Plutus Data Ordering, using this strategy
8685

8786
-- | Never apply this to any Era but Alonzo or Babbage
8887
collectTwoPhaseScriptInputsOutputOrdering ::
89-
Assertion
88+
Expectation
9089
collectTwoPhaseScriptInputsOutputOrdering = do
9190
collectInputs @AlonzoEra testEpochInfo testSystemStart defaultPParams validatingTx initUTxO
92-
@?= Right
91+
`shouldBe` Right
9392
[ PlutusWithContext
9493
{ pwcProtocolVersion = pvMajor (defaultPParams @AlonzoEra ^. ppProtocolVersionL)
9594
, pwcScript = Left plutus

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs‎

Lines changed: 15 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ import GHC.Stack
5252
import Lens.Micro
5353
import qualified PlutusLedgerApi.V1 as PV1
5454
import Test.Cardano.Ledger.Alonzo.Scripts (alwaysSucceeds)
55+
import Test.Cardano.Ledger.Common
5556
import Test.Cardano.Ledger.Conway.Era ()
5657
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
5758
import Test.Cardano.Ledger.Examples.STSTestUtils (
@@ -65,9 +66,6 @@ import Test.Cardano.Ledger.Generic.Proof
6566
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
6667
import Test.Cardano.Ledger.Shelley.Era (ShelleyEraTest)
6768
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair, mkKeyPair')
68-
import Test.Cardano.Ledger.TreeDiff (ToExpr, showExpr)
69-
import Test.Tasty
70-
import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase)
7169

7270
someKeys :: KeyPair 'Payment
7371
someKeys = KeyPair vk sk
@@ -233,7 +231,7 @@ testExpectSuccessValid ::
233231
, BabbageEraPParams era
234232
) =>
235233
TestCaseData era ->
236-
Assertion
234+
Expectation
237235
testExpectSuccessValid tc =
238236
let txBody' = txBody tc
239237
tx' = txFromTestCaseData tc
@@ -253,18 +251,16 @@ testExpectSuccessValid tc =
253251
(TRC (env, state, assumedValidTx))
254252
(genericCont (show assumedValidTx) $ Right expectedState)
255253

256-
babbageFeatures :: TestTree
254+
babbageFeatures :: Spec
257255
babbageFeatures =
258-
testGroup
259-
"Babbage Features"
260-
[ testCase "inputs and refinputs overlap in Babbage and don't Fail" $
261-
testExpectSuccessValid @BabbageEra commonReferenceScript
262-
, testCase "inputs and refinputs overlap in Conway and Fail" $
263-
testExpectUTXOFailure
264-
@ConwayEra
265-
commonReferenceScript
266-
(Conway.BabbageNonDisjointRefInputs (pure commonTxIn))
267-
]
256+
describe "Babbage Features" $ do
257+
it "inputs and refinputs overlap in Babbage and don't Fail" $
258+
testExpectSuccessValid @BabbageEra commonReferenceScript
259+
it "inputs and refinputs overlap in Conway and Fail" $
260+
testExpectUTXOFailure
261+
@ConwayEra
262+
commonReferenceScript
263+
(Conway.BabbageNonDisjointRefInputs (pure commonTxIn))
268264

269265
testExpectUTXOFailure ::
270266
forall era.
@@ -280,7 +276,7 @@ testExpectUTXOFailure ::
280276
) =>
281277
TestCaseData era ->
282278
PredicateFailure (EraRule "UTXO" era) ->
283-
Assertion
279+
Expectation
284280
testExpectUTXOFailure tc failure =
285281
let tx' = txFromTestCaseData tc
286282
InitUtxo inputs' refInputs' collateral' = initUtxoFromTestCaseData @era tc
@@ -295,9 +291,9 @@ testExpectUTXOFailure tc failure =
295291
state
296292
tx'
297293
( \case
298-
Left (predfail :| []) -> assertEqual "unexpected failure" predfail failure
299-
Left xs -> assertFailure $ "not exactly one failure" <> showExpr xs
300-
Right _ -> assertFailure "testExpectUTXOFailure succeeds"
294+
Left (predfail :| []) -> predfail `shouldBe` failure
295+
Left xs -> expectationFailure $ "not exactly one failure" <> showExpr xs
296+
Right _ -> expectationFailure "testExpectUTXOFailure succeeds"
301297
)
302298

303299
defaultPParams :: forall era. (AlonzoEraScript era, BabbageEraPParams era) => PParams era

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/STSTestUtils.hs‎

Lines changed: 14 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,6 @@ import Cardano.Ledger.State
7373
import Cardano.Ledger.TxIn (TxIn (..))
7474
import Cardano.Ledger.Val (inject)
7575
import Cardano.Slotting.Slot (SlotNo (..))
76-
import Control.Monad (when)
7776
import Control.State.Transition.Extended (STS (..), TRC (..))
7877
import Data.Default (Default (..))
7978
import Data.Foldable (Foldable (..))
@@ -86,19 +85,14 @@ import GHC.Stack
8685
import Lens.Micro (Lens', (&), (.~))
8786
import Numeric.Natural (Natural)
8887
import qualified PlutusLedgerApi.V1 as PV1
89-
import Test.Cardano.Ledger.Conway.TreeDiff (
90-
ToExpr (..),
91-
ansiDocToString,
92-
diffExpr,
93-
)
88+
import Test.Cardano.Ledger.Common hiding (Result)
9489
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr)
9590
import Test.Cardano.Ledger.Generic.Indexed (theKeyHash)
9691
import Test.Cardano.Ledger.Generic.ModelState (Model)
9792
import Test.Cardano.Ledger.Generic.Proof (Proof (..), Reflect (..), runSTS, runSTS')
9893
import Test.Cardano.Ledger.Shelley.Era (EraTest, ShelleyEraTest)
9994
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
10095
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair, mkKeyPair')
101-
import Test.Tasty.HUnit (Assertion, assertFailure, (@?=))
10296

10397
data PlutusPurposeTag
10498
= Spending
@@ -274,7 +268,7 @@ testBBODY ::
274268
Block BHeaderView era ->
275269
Either (NonEmpty (PredicateFailure (EraRule "BBODY" era))) (ShelleyBbodyState era) ->
276270
PParams era ->
277-
Assertion
271+
Expectation
278272
testBBODY initialSt block expected pparams =
279273
let env = BbodyEnv pparams def
280274
in runSTS @"BBODY" @era (TRC (env, initialSt, block)) (genericCont "" expected)
@@ -296,7 +290,7 @@ testUTXOW ::
296290
PParams era ->
297291
Tx era ->
298292
Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) (State (EraRule "UTXOW" era)) ->
299-
Assertion
293+
Expectation
300294
testUTXOW utxo p tx = testUTXOWwith (genericCont (show (utxo, tx))) utxo p tx
301295

302296
-- | Use a subset test on the expected and computed [PredicateFailure]
@@ -315,7 +309,7 @@ testUTXOWsubset ::
315309
PParams era ->
316310
Tx era ->
317311
Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) (State (EraRule "UTXOW" era)) ->
318-
Assertion
312+
Expectation
319313
testUTXOWsubset = testUTXOWwith subsetCont
320314

321315
-- | Use a test where any two (ValidationTagMismatch x y) failures match regardless of 'x' and 'y'
@@ -333,7 +327,7 @@ testUTXOspecialCase ::
333327
PParams era ->
334328
Tx era ->
335329
Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) (State (EraRule "UTXOW" era)) ->
336-
Assertion
330+
Expectation
337331
testUTXOspecialCase utxo pparam tx expected =
338332
let env = UtxoEnv (SlotNo 0) pparam def
339333
state = smartUTxOState pparam utxo (Coin 0) (Coin 0) def mempty
@@ -353,12 +347,12 @@ testUTXOWwith ::
353347
, State (EraRule "UTXOW" era) ~ UTxOState era
354348
, Tx era ~ Signal (EraRule "UTXOW" era)
355349
) =>
356-
(Result era -> Result era -> Assertion) ->
350+
(Result era -> Result era -> Expectation) ->
357351
UTxO era ->
358352
PParams era ->
359353
Tx era ->
360354
Result era ->
361-
Assertion
355+
Expectation
362356
testUTXOWwith cont utxo pparams tx expected =
363357
let env = UtxoEnv (SlotNo 0) pparams def
364358
state = smartUTxOState pparams utxo (Coin 0) (Coin 0) def mempty
@@ -391,7 +385,7 @@ genericCont ::
391385
String ->
392386
Either (t x) y ->
393387
Either (t x) y ->
394-
Assertion
388+
Expectation
395389
genericCont cause expected computed =
396390
when (computed /= expected) $
397391
assertFailure $
@@ -411,16 +405,16 @@ subsetCont ::
411405
) =>
412406
Either (t x) y ->
413407
Either (t x) y ->
414-
Assertion
408+
Expectation
415409
subsetCont expected computed =
416410
let
417411
isSubset small big = all (`elem` big) small
418412
in
419413
case (computed, expected) of
420414
(Left c, Left e) ->
421415
-- It is OK if the expected is a subset of what's computed
422-
if isSubset e c then e @?= e else c @?= e
423-
(Right c, Right e) -> c @?= e
416+
if isSubset e c then e `shouldBe` e else c `shouldBe` e
417+
(Right c, Right e) -> c `shouldBe` e
424418
(Left x, Right y) ->
425419
error $
426420
"expected to pass with "
@@ -445,15 +439,15 @@ specialCont ::
445439
) =>
446440
Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) a ->
447441
Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) a ->
448-
Assertion
442+
Expectation
449443
specialCont expected computed =
450444
case (computed, expected) of
451445
(Left (x :| []), Left (y :| [])) ->
452446
case (findMismatch (reify @era) x, findMismatch (reify @era) y) of
453-
(Just _, Just _) -> y @?= y
447+
(Just _, Just _) -> y `shouldBe` y
454448
(_, _) -> error "Not both ValidationTagMismatch case 1"
455449
(Left _, Left _) -> error "Not both ValidationTagMismatch case 2"
456-
(Right x, Right y) -> x @?= y
450+
(Right x, Right y) -> x `shouldBe` y
457451
(Left _, Right _) -> error "expected to pass, but failed."
458452
(Right _, Left _) -> error "expected to fail, but passed."
459453

0 commit comments

Comments
 (0)