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

@@ -219,7 +219,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 +234,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