Merge pull request #4912 from IntersectMBO/bolt12/fix-generator

Improved memory foot print of tests on ghc 9.8
IntersectMBO · Jul 22, 2024 · 2c70d04 · 2c70d04
2 parents 839546e + 6a4b923
commit 2c70d04
Show file tree

Hide file tree

Showing 5 changed files with 9 additions and 8 deletions.
diff --git a/flake.nix b/flake.nix
@@ -149,7 +149,7 @@
               # to discover space leaks Once #4698 and #4699 are done we can
               # further constrain the heap size.
               preCheck = lib.mkForce ''
-              export GHCRTS=-M400M
+              export GHCRTS=-M200M
               '';
 
               # pkgs are instantiated for the host platform

diff --git a/ouroboros-network-framework/CHANGELOG.md b/ouroboros-network-framework/CHANGELOG.md
@@ -9,8 +9,8 @@
 ### Non-breaking changes
 
 - Fix `InboundGovernorCounters`
-
 * Make it build with ghc-9.10
+* Improve memory footprint of tests by using strict version of STM
 
 ## 0.13.2.0 -- 2024-06-07
 

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Channel.hs b/ouroboros-network-framework/src/Ouroboros/Network/Channel.hs
@@ -31,7 +31,7 @@ import Numeric.Natural
 
 import System.IO qualified as IO (Handle, hFlush, hIsEOF)
 
-import Control.Concurrent.Class.MonadSTM
+import Control.Concurrent.Class.MonadSTM.Strict
 
 import Network.Mux.Channel qualified as Mx
 
@@ -137,8 +137,8 @@ fixedInputChannel xs0 = do
 -- writing.
 --
 mvarsAsChannel :: MonadSTM m
-               => TMVar m a
-               -> TMVar m a
+               => StrictTMVar m a
+               -> StrictTMVar m a
                -> Channel m a
 mvarsAsChannel bufferRead bufferWrite =
     Channel{send, recv}

diff --git a/ouroboros-network-protocols/CHANGELOG.md b/ouroboros-network-protocols/CHANGELOG.md
@@ -15,6 +15,7 @@
 * Bump io-sim and io-classes
 * Added a test for `AnchoredFragment.splitAtSlot`.
 * Make it build with ghc-9.10
+* Improved memory foot print of tests
 
 ## 0.8.1.0 -- 2024-03-14
 

diff --git a/ouroboros-network-protocols/testlib/Test/ChainGenerators.hs b/ouroboros-network-protocols/testlib/Test/ChainGenerators.hs
@@ -50,6 +50,7 @@ import Ouroboros.Network.Point (WithOrigin (..), block, blockPointHash,
            blockPointSlot, fromWithOrigin, origin)
 import Ouroboros.Network.Protocol.BlockFetch.Type (ChainRange (..))
 
+import Data.List (scanl')
 import Test.Cardano.Slotting.Arbitrary ()
 import Test.QuickCheck
 import Test.QuickCheck.Instances.ByteString ()
@@ -204,8 +205,7 @@ instance CoArbitrary ConcreteHeaderHash
 -- https://github.com/nick8325/quickcheck/issues/229
 --
 genNonNegative :: Gen Int
-genNonNegative = (abs <$> arbitrary) `suchThat` (>= 0)
-
+genNonNegative = (abs . getSmall <$> arbitrary) `suchThat` (>= 0)
 
 --
 -- Generators for chains
@@ -230,7 +230,7 @@ instance Arbitrary TestBlockChain where
         return (TestBlockChain chain)
       where
         mkSlots :: [Int] -> [SlotNo]
-        mkSlots = map toEnum . tail . scanl (+) 0
+        mkSlots = map toEnum . tail . scanl' (+) 0
 
     shrink (TestBlockChain c) =
         [ TestBlockChain (fixupChain fixupBlock c')