From 867df5cd9d18d58354985e18d6134f72cd271498 Mon Sep 17 00:00:00 2001 From: Fraser Murray Date: Mon, 22 May 2023 20:04:23 +0100 Subject: [PATCH] force new value of StrictMVar before calling putTMVar in updateMVar yes, this is an odd-looking change. it's not unreasonable to assume that forcing !(!a', b) inside the atomically block will force the new value before putting it into the MVar, but there's actually an additional closure constructed (with a dependency on a') that will only force a' when *it's* evaluated! in order to ensure that we're forcing the value inside the MVar before calling checkInvariant, we need an additional bang outside the atomically block, which will correctly force a' before checkInvariant looks to see if it's been evaluated or not. without this change, it's possible to put a lazy value inside a StrictMVar (though it's very unlikely that this has happened in the past in production environments because this intermediate unforced closure is optimized away at -O1 and above) --- .../Ouroboros/Consensus/Util/MonadSTM/StrictMVar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/MonadSTM/StrictMVar.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/MonadSTM/StrictMVar.hs index 39db94ac80..156f031fa5 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/MonadSTM/StrictMVar.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/MonadSTM/StrictMVar.hs @@ -168,7 +168,7 @@ isEmptyMVar StrictMVar { tmvar } = atomically $ Lazy.isEmptyTMVar tmvar updateMVar :: (MonadSTM m, HasCallStack) => StrictMVar m a -> (a -> (a, b)) -> m b updateMVar StrictMVar { tmvar, tvar, invariant } f = do - (a', b) <- atomically $ do + (!a', b) <- atomically $ do a <- Lazy.takeTMVar tmvar let !(!a', b) = f a Lazy.putTMVar tmvar a'