@@ -712,11 +712,10 @@ performMergeSteps ::
712
712
-> Credits
713
713
-> m Bool
714
714
performMergeSteps mergeVar creditsVar (Credits credits) =
715
+ assert (credits >= 0 ) $
715
716
withMVar mergeVar $ \ case
716
717
CompletedMerge {} -> pure False
717
718
OngoingMerge _rs m -> do
718
- -- We have dealt with the case of credits <= 0 above,
719
- -- so here we know credits is positive
720
719
let stepsToDo = credits
721
720
(stepsDone, stepResult) <- Merge. steps m stepsToDo
722
721
assert (stepResult == MergeDone || stepsDone >= stepsToDo) (pure () )
@@ -753,8 +752,9 @@ completeMerge mergeVar mergeKnownCompletedVar = do
753
752
(OngoingMerge rs m) -> do
754
753
-- first try to complete the merge before performing other side effects,
755
754
-- in case the completion fails
756
- -- TODO: Run.fromMutable claims not to be exception safe
757
- -- may need to use uninteruptible mask
755
+ -- TODO: Run.fromMutable (used in Merge.complete) claims not to be
756
+ -- exception safe so we should probably be using the resource registry
757
+ -- and test for exception safety.
758
758
r <- Merge. complete m
759
759
V. forM_ rs releaseRef
760
760
-- Cache the knowledge that we completed the merge
@@ -778,11 +778,13 @@ expectCompleted (DeRef MergingRun {..}) = do
778
778
let totalDebt = numEntriesToTotalDebt mergeNumEntries
779
779
suppliedCredits = spentCredits + unspentCredits
780
780
! credits = assert (suppliedCredits == totalDebt) $
781
+ assert (unspentCredits >= 0 ) $
781
782
unspentCredits
782
783
783
- -- TODO: what about exception safety: check if it is ok to be interrupted
784
- -- between performMergeSteps and completeMerge here, and above.
785
784
weFinishedMerge <- performMergeSteps mergeState mergeCreditsVar credits
785
+ -- If an async exception happens before we get to perform the
786
+ -- completion, then that is fine. The next 'expectCompleted' will
787
+ -- complete the merge.
786
788
when weFinishedMerge $ completeMerge mergeState mergeKnownCompleted
787
789
withMVar mergeState $ \ case
788
790
CompletedMerge r -> dupRef r -- return a fresh reference to the run
0 commit comments