Fix Shelley unit test by accounting for the new field

IntersectMBO · Apr 25, 2024 · b839237 · b839237
1 parent 1b29ef4
commit b839237
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 7 deletions.
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples.hs
@@ -12,6 +12,7 @@ import Cardano.Ledger.Shelley.Scripts ()
 import Cardano.Protocol.TPraos.BHeader (BHeader)
 import Control.State.Transition.Extended hiding (Assertion)
 import Data.List.NonEmpty (NonEmpty)
+import GHC.Stack
 import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, C_Crypto)
 import Test.Cardano.Ledger.Shelley.Rules.Chain (CHAIN, ChainState, totalAda)
 import Test.Cardano.Ledger.Shelley.TreeDiff (expectExprEqual)
@@ -30,7 +31,7 @@ data CHAINExample h era = CHAINExample
 
 -- | Runs example, applies chain state transition system rule (STS),
 --   and checks that trace ends with expected state or expected error.
-testCHAINExample :: CHAINExample (BHeader C_Crypto) C -> Assertion
+testCHAINExample :: HasCallStack => CHAINExample (BHeader C_Crypto) C -> Assertion
 testCHAINExample (CHAINExample initSt block (Right expectedSt)) = do
   (checkTrace @(CHAIN C) runShelleyBase () $ pure initSt .- block .->> expectedSt)
     >> expectExprEqual (totalAda expectedSt) maxLLSupply

diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs
@@ -52,6 +52,7 @@ import Cardano.Ledger.BaseTypes (
   BlocksMade (..),
   Nonce (..),
   StrictMaybe (..),
+  quorum,
   (⭒),
  )
 import Cardano.Ledger.Block (
@@ -94,7 +95,7 @@ import Cardano.Ledger.Shelley.LedgerState (
   updateStakeDistribution,
  )
 import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates)
-import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards)
+import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards, votedFuturePParams)
 import Cardano.Ledger.UMap (
   RDPair (..),
   UView (PtrUView, RewDepUView, SPoolUView),
@@ -123,7 +124,7 @@ import Data.Word (Word64)
 import Lens.Micro ((&), (.~), (^.))
 import Lens.Micro.Extras (view)
 import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
-import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce)
+import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce, testGlobals)
 
 -- ======================================================
 
@@ -717,7 +718,7 @@ newEpoch b cs = cs'
 -- Set the current protocol parameter proposals.
 setCurrentProposals ::
   forall era.
-  GovState era ~ ShelleyGovState era =>
+  (GovState era ~ ShelleyGovState era, EraPParams era) =>
   ProposedPPUpdates era ->
   ChainState era ->
   ChainState era
@@ -727,9 +728,14 @@ setCurrentProposals ps cs = cs {chainNes = nes'}
     es = nesEs nes
     ls = esLState es
     utxoSt = lsUTxOState ls
-    ppupSt = utxosGovState utxoSt
-    ppupSt' = ppupSt {sgsCurProposals = ps}
-    utxoSt' = utxoSt {utxosGovState = ppupSt'}
+    govState = utxosGovState utxoSt
+    pp = sgsCurPParams govState
+    govState' =
+      govState
+        { sgsCurProposals = ps
+        , sgsFuturePParams = votedFuturePParams ps pp (quorum testGlobals)
+        }
+    utxoSt' = utxoSt {utxosGovState = govState'}
     ls' = ls {lsUTxOState = utxoSt'}
     es' = es {esLState = ls'}
     nes' = nes {nesEs = es'}