From c364e76c6f675092e8afbcd217d0ff7beffcfbff Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 25 Aug 2021 02:11:25 +0200
Subject: [PATCH] Fix disposing an empty resource manager after a delay
---
src/Quasar/Disposable.hs | 13 +++++++------
test/Quasar/AwaitableSpec.hs | 6 +++---
2 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index c805346..6ecb90a 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 9016cfa..cfba16f 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
--
GitLab