diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs index c80534616f0bf358a80c50f7cefc42a32d98c1d3..6ecb90a9d2f949a1d9db7cad9e77cc0cf5ae0e9a 100644 --- a/src/Quasar/Disposable.hs +++ b/src/Quasar/Disposable.hs @@ -255,19 +255,20 @@ collectGarbage resourceManager = go >> traceIO "gc: completed" go :: IO () go = do traceIO "gc: go" - (snapshot, disposing) <- atomically $ do - snapshot <- readTVar entriesVar' - disposing <- readTVar (disposingVar resourceManager) - pure (snapshot, disposing) + snapshot <- atomically $ readTVar entriesVar' - let listChanged = simpleAwaitable $ do + let listChanged = simpleAwaitable do newLength <- Seq.length <$> readTVar entriesVar' when (newLength == Seq.length snapshot) retry + isDisposing = simpleAwaitable do + disposing <- readTVar (disposingVar resourceManager) + unless disposing retry + -- Wait for any entry to complete or until a new entry is added let awaitables = (toAwaitable <$> toList snapshot) awaitIO if Quasar.Prelude.null awaitables - then unless disposing $ listChanged + then awaitAny2 listChanged isDisposing else awaitAny (listChanged :| awaitables) traceIO "gc: change detected" diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs index 9016cfaa01561099e790e28de6723644a6b5ea4a..cfba16f192e5cb4ebf292f8cb4264310125f6dfe 100644 --- a/test/Quasar/AwaitableSpec.hs +++ b/test/Quasar/AwaitableSpec.hs @@ -30,7 +30,7 @@ spec = parallel $ do awaitIO avar - it "can be awaited and completed later" $ do + it "can be awaited when completed asynchronously" $ do avar <- newAsyncVar :: IO (AsyncVar ()) void $ forkIO $ do threadDelay 100000 @@ -86,7 +86,7 @@ spec = parallel $ do putAsyncVar_ avar () withDefaultAsyncManager (id <$> await avar) - xit "can fmap the result of an async that is completed later" $ do + it "can fmap the result of an async that is completed later" $ do avar <- newAsyncVar :: IO (AsyncVar ()) void $ forkIO $ do threadDelay 100000 @@ -98,7 +98,7 @@ spec = parallel $ do putAsyncVar_ avar () withDefaultAsyncManager (await avar >>= pure) - xit "can bind the result of an async that is completed later" $ do + it "can bind the result of an async that is completed later" $ do avar <- newAsyncVar :: IO (AsyncVar ()) void $ forkIO $ do threadDelay 100000