diff --git a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs index ac31aae5d0..ee089e3b93 100644 --- a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs +++ b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs @@ -28,7 +28,6 @@ import Control.Monad.Trans.Except (except) import Data.Set (Set, (\\)) import qualified Data.Set as Set import Data.TreeDiff (ToExpr) -import Data.Word (Word8) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) import qualified Ouroboros.Consensus.Block as Block @@ -56,7 +55,7 @@ data Tx = Tx { deriving stock (Eq, Ord, Generic, Show) deriving anyclass (NoThunks, NFData) -newtype Token = Token { unToken :: Word8 } +newtype Token = Token { unToken :: Int } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NoThunks, ToExpr, Serialise, NFData) @@ -81,7 +80,7 @@ sampleLedgerConfig = testBlockLedgerConfigFrom $ -------------------------------------------------------------------------------} data TestLedgerState = TestLedgerState { - availableTokens :: Set Token + availableTokens :: !(Set Token) } deriving stock (Generic, Eq, Show) deriving anyclass (NoThunks, ToExpr, Serialise) diff --git a/ouroboros-consensus/bench/mempool-bench/Main.hs b/ouroboros-consensus/bench/mempool-bench/Main.hs index f62d1b5f26..597fab935b 100644 --- a/ouroboros-consensus/bench/mempool-bench/Main.hs +++ b/ouroboros-consensus/bench/mempool-bench/Main.hs @@ -11,7 +11,8 @@ import Bench.Consensus.Mempool import Bench.Consensus.Mempool.TestBlock (TestBlock) import qualified Bench.Consensus.Mempool.TestBlock as TestBlock import Control.Arrow (first) -import Control.Monad (unless, void) +import Control.DeepSeq +import Control.Monad (unless) import qualified Control.Tracer as Tracer import Data.Aeson import qualified Data.ByteString.Lazy as BL @@ -27,7 +28,7 @@ import qualified Test.Consensus.Mempool.Mocked as Mocked import Test.Consensus.Mempool.Mocked (MockedMempool) import Test.Tasty (withResource) import Test.Tasty.Bench (CsvPath (CsvPath), bench, benchIngredients, - bgroup, nfIO) + bgroup, whnfIO) import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.Options (changeOption) import Test.Tasty.Runners (parseOptions, tryIngredients) @@ -50,24 +51,27 @@ main = withStdTerminalHandles $ do where benchmarkJustAddingTransactions = bgroup "Just adding" $ - fmap benchAddNTxs [10_000, 1_000_000] + fmap benchAddNTxs [10_000, 20_000] where benchAddNTxs n = withResource - (let txs = mkNTryAddTxs n in fmap (, txs) (openMempoolWithCapacityFor txs)) + (pure $!! mkNTryAddTxs n) (\_ -> pure ()) - (\getAcquiredRes -> do - let withAcquiredMempool act = do - (mempool, txs) <- getAcquiredRes - void $ act mempool txs - -- TODO: consider adding a 'reset' command to the mempool to make sure its state is not tainted. - Mocked.removeTxs mempool $ getCmdsTxIds txs + (\getTxs -> do bgroup (show n <> " transactions") [ - bench "benchmark" $ nfIO $ withAcquiredMempool $ \mempool txs -> do + bench "setup mempool" $ whnfIO $ do + txs <- getTxs + openMempoolWithCapacityFor txs + , bench "setup mempool + benchmark" $ whnfIO $ do + txs <- getTxs + mempool <- openMempoolWithCapacityFor txs run mempool txs - , testCase "test" $ withAcquiredMempool $ \mempool txs -> + , testCase "test" $ do + txs <- getTxs + mempool <- openMempoolWithCapacityFor txs testAddTxs mempool txs - , testCase "txs length" $ withAcquiredMempool $ \_mempool txs -> do + , testCase "txs length" $ do + txs <- getTxs length txs @?= n ] )