98b4fc3 · streamly · git.iko.soy

git.iko.soy/streamly

clear the finalizer from IORef on exception

on exception handling the finalizer was left installed in the IORef to be run by GC, this could cause the finalizer to be run twice.

commit98b4fc3c6f6aab74349f87b474eb9e4b113d1153 authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 30 Jan 2020, 16:06 (7 years ago) parentd7d42be

2 files changed+43−29

compare with master

unifiedsplit

src/Streamly/Internal/Data/Stream/StreamD.hs+23−7 src/Streamly/Internal/Data/Unfold.hs+20−22

src/Streamly/Internal/Data/Stream/StreamD.hs+23−7

@@ -296,6 +296,8 @@ module Streamly.Internal.Data.Stream.StreamD

296296

297297 -- * Exceptions

298298 , newFinalizedIORef

299+ , runIORefFinalizer

300+ , clearIORefFinalizer

299301 , gbracket

300302 , before

301303 , after

@@ -2899,6 +2901,21 @@ newFinalizedIORef finalizer = do

28992901 _ <- liftIO $ mkWeakIORef ref finalizer1

29002902 return ref

29012903

2904+-- | Run the finalizer stored in an IORef and deactivate it so that it is run

2905+-- only once.

2906+--

2907+runIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()

2908+runIORefFinalizer ref = liftIO $ do

2909+ res <- readIORef ref

2910+ case res of

2911+ Nothing -> return ()

2912+ Just f -> writeIORef ref Nothing >> f

2913+

2914+-- | Deactivate the finalizer stored in an IORef without running it.

2915+--

2916+clearIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()

2917+clearIORefFinalizer ref = liftIO $ writeIORef ref Nothing

2918+

29022919data GbracketIOState s1 s2 v wref

29032920 = GBracketIOInit

29042921 | GBracketIONormal s1 v wref

@@ -2946,10 +2963,10 @@ gbracketIO bef exc aft fexc fnormal =

29462963 Skip s ->

29472964 return $ Skip (GBracketIONormal (Stream step1 s) v ref)

29482965 Stop -> do

2949− liftIO (writeIORef ref Nothing)

2950− aft v >> return Stop

2966+ runIORefFinalizer ref

2967+ return Stop

29512968 Left e -> do

2952− liftIO (writeIORef ref Nothing)

2969+ clearIORefFinalizer ref

29532970 return $ Skip (GBracketIOException (fexc v e))

29542971 step gst (GBracketIOException (UnStream step1 st)) = do

29552972 res <- step1 gst st

@@ -3007,10 +3024,9 @@ afterIO action (Stream step state) = Stream step' Nothing

30073024 case res of

30083025 Yield x s -> return $ Yield x (Just (s, ref))

30093026 Skip s -> return $ Skip (Just (s, ref))

3010− Stop -> liftIO $ do

3011− Just f <- readIORef ref

3012− writeIORef ref Nothing

3013− f >> return Stop

3027+ Stop -> do

3028+ runIORefFinalizer ref

3029+ return Stop

30143030

30153031-- XXX These combinators are expensive due to the call to

30163032-- onException/handle/try on each step. Therefore, when possible, they should

src/Streamly/Internal/Data/Unfold.hs+20−22

@@ -128,7 +128,6 @@ where

128128import Control.Exception (Exception)

129129import Control.Monad.IO.Class (MonadIO(..))

130130import Control.Monad.Trans.Control (MonadBaseControl)

131−import Data.IORef (readIORef, writeIORef)

132131import Data.Void (Void)

133132import GHC.Types (SPEC(..))

134133import Prelude hiding (concat, map, mapM, takeWhile, take, filter, const)

@@ -694,10 +693,10 @@ gbracketIO bef exc aft (Unfold estep einject) (Unfold step1 inject1) =

694693 Yield x s -> return $ Yield x (Right (s, v, ref))

695694 Skip s -> return $ Skip (Right (s, v, ref))

696695 Stop -> do

697− liftIO $ writeIORef ref Nothing

698− aft v >> return Stop

696+ D.runIORefFinalizer ref

697+ return Stop

699698 Left e -> do

700− liftIO (writeIORef ref Nothing)

699+ D.clearIORefFinalizer ref

701700 r <- einject (v, e)

702701 return $ Skip (Left r)

703702 step (Left st) = do

@@ -789,10 +788,9 @@ afterIO action (Unfold step1 inject1) = Unfold step inject

789788 case res of

790789 Yield x s -> return $ Yield x (s, ref)

791790 Skip s -> return $ Skip (s, ref)

792− Stop -> liftIO $ do

793− Just f <- readIORef ref

794− writeIORef ref Nothing

795− f >> return Stop

791+ Stop -> do

792+ D.runIORefFinalizer ref

793+ return Stop

796794

797795{-# INLINE_NORMAL _onException #-}

798796_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

@@ -868,17 +866,17 @@ finallyIO action (Unfold step1 inject1) = Unfold step inject

868866 inject x = do

869867 s <- inject1 x

870868 ref <- D.newFinalizedIORef (action x)

871− return (s, x, ref)

869+ return (s, ref)

872870

873871 {-# INLINE_LATE step #-}

874− step (st, v, ref) = do

875− res <- step1 st `MC.onException` action v

872+ step (st, ref) = do

873+ res <- step1 st `MC.onException` D.runIORefFinalizer ref

876874 case res of

877− Yield x s -> return $ Yield x (s, v, ref)

878− Skip s -> return $ Skip (s, v, ref)

875+ Yield x s -> return $ Yield x (s, ref)

876+ Skip s -> return $ Skip (s, ref)

879877 Stop -> do

880− liftIO (writeIORef ref Nothing)

881− action v >> return Stop

878+ D.runIORefFinalizer ref

879+ return Stop

882880

883881{-# INLINE_NORMAL _bracket #-}

884882_bracket :: MonadCatch m

@@ -935,17 +933,17 @@ bracketIO bef aft (Unfold step1 inject1) = Unfold step inject

935933 r <- bef x

936934 s <- inject1 r

937935 ref <- D.newFinalizedIORef (aft r)

938− return (s, r, ref)

936+ return (s, ref)

939937

940938 {-# INLINE_LATE step #-}

941− step (st, v, ref) = do

942− res <- step1 st `MC.onException` aft v

939+ step (st, ref) = do

940+ res <- step1 st `MC.onException` D.runIORefFinalizer ref

943941 case res of

944− Yield x s -> return $ Yield x (s, v, ref)

945− Skip s -> return $ Skip (s, v, ref)

942+ Yield x s -> return $ Yield x (s, ref)

943+ Skip s -> return $ Skip (s, ref)

946944 Stop -> do

947− liftIO (writeIORef ref Nothing)

948− aft v >> return Stop

945+ D.runIORefFinalizer ref

946+ return Stop

949947

950948-- | When unfolding if an exception occurs, unfold the exception using the

951949-- exception unfold supplied as the first argument to 'handle'.