Scale down tests to make test suites run faster

Author: Soupstraw

eras/dijkstra/impl/CHANGELOG.md

@@ -71,6 +71,7 @@
 
 ### testlib
 
+* Add `genSmallDijkstraBlockBody`
 * Add to `Test.Cardano.Ledger.Dijkstra.Examples`:
   - `exampleDijkstraOnwardsEraPParams`
   - `exampleDijkstraOnwardsEraPParamsUpdate`

eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs

@@ -975,10 +975,13 @@ instance HuddleRule "block_body" DijkstraEra where
 
 blockBodyGen :: CBORGen RuleTerm
 blockBodyGen = do
-  numTxs <- liftGen . Gen.sized $ \s -> choose (0 :: Int, s)
+  numTxs <- liftGen . Gen.sized $ \s -> choose (0 :: Int, s `div` 15)
   txs <-
     mapM
-      (\i -> withAntiGen (withAnnotation (T.pack $ show i)) $ generateFromName "transaction")
+      ( \i ->
+          withAntiGen (withAnnotation (T.pack $ show i)) . scale (`div` max 1 numTxs) $
+            generateFromName "transaction"
+      )
       [0 .. numTxs - 1]
   invalidIxIxs <-
     if numTxs == 0

eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/Binary/CddlSpec.hs

@@ -35,18 +35,18 @@ import Test.Cardano.Ledger.Core.Binary (
   fullCddlSpec,
   fullGenCddlSpec,
  )
-import Test.Cardano.Ledger.Dijkstra.Arbitrary (genNonEmptyAccountBalanceIntervals)
+import Test.Cardano.Ledger.Dijkstra.Arbitrary (
+  genNonEmptyAccountBalanceIntervals,
+  genSmallDijkstraBlockBody,
+ )
 import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
 
 spec :: Spec
 spec = do
   describe "CDDL" $ do
     let v = eraProtVerHigh @DijkstraEra
     describe "Huddle" $ specWithHuddle dijkstraCDDL . noTwiddle $ do
-      -- BlockBody
-      xdescribe "fix transaction" $
-        fullAnnCddlSpec @(BlockBody DijkstraEra) v "block_body"
-      -- AccountBalanceInterval
+      fullAnnGenCddlSpec @(BlockBody DijkstraEra) genSmallDijkstraBlockBody v "block_body"
       fullCddlSpec @(AccountBalanceInterval DijkstraEra) v "account_balance_interval"
       fullGenCddlSpec @(AccountBalanceIntervals DijkstraEra)
         genNonEmptyAccountBalanceIntervals

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs

@@ -14,7 +14,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Cardano.Ledger.Dijkstra.Arbitrary (genNonEmptyAccountBalanceIntervals) where
+module Test.Cardano.Ledger.Dijkstra.Arbitrary (genNonEmptyAccountBalanceIntervals, genSmallDijkstraBlockBody) where
 
 import Cardano.Ledger.Allegra.Scripts (
   pattern RequireTimeExpire,
@@ -40,6 +40,7 @@ import Cardano.Ledger.Shelley.Scripts (pattern RequireSignature)
 import Data.Functor.Identity (Identity)
 import qualified Data.Map.Strict as Map
 import qualified Data.OMap.Strict as OMap
+import qualified Data.Sequence.Strict as SSeq
 import Data.Typeable (Typeable)
 import Generic.Random (genericArbitraryU)
 import Test.Cardano.Ledger.Allegra.Arbitrary (maxTimelockDepth)
@@ -303,6 +304,21 @@ instance
   where
   arbitrary = DijkstraBlockBody <$> arbitrary <*> arbitrary
 
+genSmallDijkstraBlockBody ::
+  ( AlonzoEraTx era
+  , Arbitrary (Tx TopTx era)
+  ) =>
+  Gen (DijkstraBlockBody era)
+genSmallDijkstraBlockBody = DijkstraBlockBody <$> genFewTxs <*> arbitrary
+  where
+    genFewTxs = sized $ \sz -> do
+      numTxs <-
+        frequency
+          [ (99, choose (1, max 1 $ sz `div` 20))
+          , (1, pure 0)
+          ]
+      SSeq.fromList <$> vectorOf numTxs (scale (`div` numTxs) arbitrary)
+
 deriving newtype instance Arbitrary (ApplyTxError DijkstraEra)
 
 instance Arbitrary (DijkstraMempoolPredFailure DijkstraEra) where