WP

Author: jorisdral

test/Database/LSMTree/Class.hs

@@ -28,6 +28,7 @@ import qualified Database.LSMTree.Internal.Paths as RIP
 import qualified Database.LSMTree.Internal.Types as RT (Table (..))
 import qualified Database.LSMTree.Internal.Unsafe as RU (SessionEnv (..),
                      Table (..), withKeepSessionOpen)
+import           GHC.Stack (HasCallStack)
 import           Test.Util.FS (flipRandomBitInRandomFileHardlinkSafe)
 import           Test.Util.QC (Choice)
 
@@ -106,31 +107,35 @@ class (IsSession (Session h)) => IsTable h where
         -> m (V.Vector b)
 
     updates ::
-           ( IOLike m
+           ( HasCallStack
+           , IOLike m
            , C k v b
            )
         => h m k v b
         -> V.Vector (k, Update v b)
         -> m ()
 
     inserts ::
-           ( IOLike m
+           ( HasCallStack
+           , IOLike m
            , C k v b
            )
         => h m k v b
         -> V.Vector (k, v, Maybe b)
         -> m ()
 
     deletes ::
-           ( IOLike m
+           ( HasCallStack
+           , IOLike m
            , C k v b
            )
         => h m k v b
         -> V.Vector k
         -> m ()
 
     upserts ::
-           ( IOLike m
+           ( HasCallStack
+           , IOLike m
            , C k v b
            )
         => h m k v b

test/Test/Database/LSMTree/UnitTests.hs

@@ -17,6 +17,7 @@ import           Database.LSMTree as R
 import           Database.LSMTree.Extras.Generators ()
 import           Database.LSMTree.Internal.Serialise (SerialisedKey)
 import qualified System.FS.API as FS
+import           System.Mem (performMajorGC)
 import qualified Test.QuickCheck.Arbitrary as QC
 import qualified Test.QuickCheck.Gen as QC
 import           Test.Tasty (TestTree, testGroup)
@@ -219,7 +220,7 @@ unit_union_credit_0 =
 -- | Blob refs into a union don't get invalidated when updating the union's
 -- input tables.
 unit_union_blobref_invalidation :: Assertion
-unit_union_blobref_invalidation = forM_ @[] @IO @Int [1..100] $ \_ ->
+unit_union_blobref_invalidation = (\_ -> performMajorGC) =<< (forM_ @[] @IO @Int [1..100] $ \_ ->
     withTempIOHasBlockIO "test" $ \hfs hbio ->
     withOpenSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \sess ->
     withTableWith config sess $ \t1 -> do
@@ -234,7 +235,7 @@ unit_union_blobref_invalidation = forM_ @[] @IO @Int [1..100] $ \_ ->
         inserts t1 (fmap (\i -> (Key1 i, Value1 i, Nothing)) [1000..2000])
 
         -- try to resolve the blob refs we obtained earlier
-        void $ retrieveBlobs sess (V.mapMaybe R.getBlob res)
+        void $ retrieveBlobs sess (V.mapMaybe R.getBlob res))
   where
     config = defaultTableConfig {
         confWriteBufferAlloc = AllocNumEntries 4