diff --git a/hbs2-core/lib/HBS2/Storage/Operations/Delete.hs b/hbs2-core/lib/HBS2/Storage/Operations/Delete.hs index ceda0b23..9184b348 100644 --- a/hbs2-core/lib/HBS2/Storage/Operations/Delete.hs +++ b/hbs2-core/lib/HBS2/Storage/Operations/Delete.hs @@ -23,5 +23,6 @@ deleteMerkleTree sto root = do S.yield ha for_ (reverse what) $ \ha -> do + -- debug $ "delete" <+> pretty ha delBlock sto ha diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs index 0cdff658..b9496131 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs @@ -1270,7 +1270,7 @@ ncqStorageInit_ check path = do ncqIndexed <- newTVarIO mempty ncqMergeReq <- newTVarIO 0 ncqCompactReq <- newTVarIO 0 - ncqCompactBusy <- newEmptyTMVarIO + ncqCompactBusy <- newTMVarIO () ncqFsyncNum <- newTVarIO 0 ncqLock <- newTVarIO ncqLock_ @@ -1630,6 +1630,7 @@ ncqLinearScanForCompact ncq@NCQStorage{..} action = flip runContT pure do case HM.lookup kk state of Just ts | ts > timeSpecFromFilePrio p -> do + notice $ pretty kk <+> pretty (sz + ncqSLen) atomically do modifyTVar profit ( + (sz + ncqSLen) ) modifyTVar tombUse (HM.adjust (over _2 succ) kk) diff --git a/hbs2-tests/test/TCQ.hs b/hbs2-tests/test/TCQ.hs index 514365a1..6ac4697f 100644 --- a/hbs2-tests/test/TCQ.hs +++ b/hbs2-tests/test/TCQ.hs @@ -243,6 +243,19 @@ main = do pure nil + entry $ bindMatch "ncq:compact:scan" $ \syn -> lift do + + tcq <- case syn of + [ isOpaqueOf @TCQ -> Just tcq ] -> do + pure tcq + + e -> throwIO $ BadFormException @C (mkList e) + + ncq <- getNCQ tcq + r <- ncqLinearScanForCompact ncq (\_ _ -> none) + + pure $ mkInt r + entry $ bindMatch "ncq:merge" $ \syn -> lift do tcq <- case syn of