Merge pull request #5327 from IntersectMBO/nm/exunits-tests

Move cardano-ledger-core ExUnits tests from testlib to test

Author: lehins

libs/cardano-ledger-core/CHANGELOG.md

@@ -12,6 +12,7 @@
 
 ### `testlib`
 
+* Remove `Test.Cardano.Ledger.Plutus.ExUnits`
 * Remove the `accountsToUMap` member function from the `EraTest` class.
   - Also remove the related `accountsFromUMap` function.
 * Remove the following from `Core.Arbitrary`:

libs/cardano-ledger-core/cardano-ledger-core.cabal

@@ -185,7 +185,6 @@ library testlib
     Test.Cardano.Ledger.Era
     Test.Cardano.Ledger.Imp.Common
     Test.Cardano.Ledger.Plutus
-    Test.Cardano.Ledger.Plutus.ExUnits
     Test.Cardano.Ledger.Plutus.Examples
     Test.Cardano.Ledger.Plutus.Guardrail
     Test.Cardano.Ledger.Plutus.ScriptTestContext

libs/cardano-ledger-core/test/Test/Cardano/Ledger/PlutusSpec.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE BinaryLiterals #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -24,12 +23,62 @@ import Data.Word
 import Numeric.Natural (Natural)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Arbitrary ()
-import Test.Cardano.Ledger.Plutus.ExUnits qualified as ExUnits
 import Test.Cardano.Ledger.Plutus.ToPlutusData (roundTripPlutusDataSpec)
 
 spec :: Spec
 spec = do
-  costModelsSpec
+  describe "Plutus" $ do
+    costModelsSpec
+    exUnitsSpec
+    dataSpec
+
+costModelsSpec :: Spec
+costModelsSpec = do
+  describe "CostModels" $ do
+    prop "flattenCostModels . mkCostModelsLenient" $ \valid unknown -> do
+      let cms1Flat = flattenCostModels valid <> unknown
+          cms2Flat = unknown <> flattenCostModels valid
+      cms1 <- mkCostModelsLenient cms1Flat
+      cms2 <- mkCostModelsLenient cms2Flat
+      flattenCostModels cms1 `shouldBe` cms1Flat
+      flattenCostModels cms2 `shouldBe` cms2Flat
+
+exUnitsSpec :: Spec
+exUnitsSpec = do
+  describe "ExUnits" $ do
+    prop "Round-trip to ExBudget" exUnitsToExBudgetRoundTrip
+    prop "Round-trip from ExBudget" exBudgetToExUnitsRoundTrip
+
+-- ExUnits should remain intact when translating to and from the Plutus ExBudget type
+exUnitsToExBudgetRoundTrip :: Gen Property
+exUnitsToExBudgetRoundTrip = do
+  e <- arbitrary
+  let result = exBudgetToExUnits $ transExUnits e
+  pure
+    $ counterexample
+      ( "Before: "
+          <> show e
+          <> "\n After: "
+          <> show result
+      )
+    $ result == Just e
+
+-- Plutus ExBudget should remain intact when translating to and from the ExUnits type
+exBudgetToExUnitsRoundTrip :: Gen Property
+exBudgetToExUnitsRoundTrip = do
+  e <- arbitrary
+  let result = transExUnits <$> exBudgetToExUnits e
+  pure
+    $ counterexample
+      ( "Before: "
+          <> show e
+          <> "\n After: "
+          <> show result
+      )
+    $ result == Just e
+
+dataSpec :: Spec
+dataSpec = do
   describe "RoundTrip ToPlutusData" $ do
     roundTripPlutusDataSpec @Version
     roundTripPlutusDataSpec @Word
@@ -50,16 +99,3 @@ spec = do
     roundTripPlutusDataSpec @ProtVer
     roundTripPlutusDataSpec @CostModels
     roundTripPlutusDataSpec @Integer
-  describe "ExUnits" $ do
-    ExUnits.spec
-
-costModelsSpec :: Spec
-costModelsSpec = do
-  describe "CostModels" $ do
-    prop "flattenCostModels . mkCostModelsLenient" $ \valid unknown -> do
-      let cms1Flat = flattenCostModels valid <> unknown
-          cms2Flat = unknown <> flattenCostModels valid
-      cms1 <- mkCostModelsLenient cms1Flat
-      cms2 <- mkCostModelsLenient cms2Flat
-      flattenCostModels cms1 `shouldBe` cms1Flat
-      flattenCostModels cms2 `shouldBe` cms2Flat