From 8b263600dcfd73fa56b2ab3a1a01d2e567413cfd Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 25 Aug 2021 03:11:24 +0200
Subject: [PATCH] Add more tests
---
src/Quasar/Disposable.hs | 3 ++-
test/Quasar/DisposableSpec.hs | 31 +++++++++++++++++++++++++++++++
2 files changed, 33 insertions(+), 1 deletion(-)
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index 6ecb90a..03cb56b 100644
--- a/src/Quasar/Disposable.hs
+++ b/src/Quasar/Disposable.hs
@@ -273,7 +273,8 @@ collectGarbage resourceManager = go >> traceIO "gc: completed"
traceIO "gc: change detected"
- -- Check entries for completion. Completion will be queried with `entryIsEmpty` during the next STM transaction.
+ -- Checking entries for completion has to be done in IO.
+ -- Completion is then queried with `entryIsEmpty` during the following STM transaction.
checkEntries =<< atomically (readTVar entriesVar')
traceIO "gc: entries checked"
diff --git a/test/Quasar/DisposableSpec.hs b/test/Quasar/DisposableSpec.hs
index de3982d..0acc9e0 100644
--- a/test/Quasar/DisposableSpec.hs
+++ b/test/Quasar/DisposableSpec.hs
@@ -1,5 +1,6 @@
module Quasar.DisposableSpec (spec) where
+import Control.Exception
import Control.Concurrent
import Control.Monad (void)
import Prelude
@@ -7,6 +8,11 @@ import Test.Hspec
import Quasar.Awaitable
import Quasar.Disposable
+data TestException = TestException
+ deriving (Eq, Show)
+
+instance Exception TestException
+
spec :: Spec
spec = parallel $ do
describe "Disposable" $ do
@@ -36,6 +42,13 @@ spec = parallel $ do
withResourceManager \resourceManager -> do
attachDisposable resourceManager noDisposable
+ it "can attach an disposable" $ do
+ withResourceManager \resourceManager -> do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ attachDisposable resourceManager $ alreadyDisposing avar
+ putAsyncVar_ avar ()
+ pure () :: IO ()
+
it "can dispose an awaitable that is completed asynchronously" $ do
avar <- newAsyncVar :: IO (AsyncVar ())
void $ forkIO $ do
@@ -44,3 +57,21 @@ spec = parallel $ do
withResourceManager \resourceManager -> do
attachDisposable resourceManager (alreadyDisposing avar)
+
+ it "can call a trivial dispose action" $ do
+ withResourceManager \resourceManager ->
+ attachDisposeAction resourceManager $ pure $ pure ()
+ pure () :: IO ()
+
+ it "can call a dispose action" $ do
+ withResourceManager \resourceManager -> do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ attachDisposeAction resourceManager $ toAwaitable avar <$ putAsyncVar_ avar ()
+ pure () :: IO ()
+
+ it "re-throws an exception from a dispose action" $ do
+ shouldThrow
+ do
+ withResourceManager \resourceManager ->
+ attachDisposeAction resourceManager $ throwIO $ TestException
+ \TestException -> True
--
GitLab