From 509c8d41867cb8fccb631b914ccad064032108fb Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 5 Oct 2021 17:35:51 +0200
Subject: [PATCH] Add more resource manager tests (failing)
---
src/Quasar/PreludeExtras.hs | 2 --
test/Quasar/ResourceManagerSpec.hs | 13 +++++++++++++
2 files changed, 13 insertions(+), 2 deletions(-)
diff --git a/src/Quasar/PreludeExtras.hs b/src/Quasar/PreludeExtras.hs
index c1d1edd..9d9b6ad 100644
--- a/src/Quasar/PreludeExtras.hs
+++ b/src/Quasar/PreludeExtras.hs
@@ -16,9 +16,7 @@ import Data.HashSet qualified as HS
import Data.Hashable qualified as Hashable
import Data.List qualified as List
import Data.Maybe qualified as Maybe
-import GHC.Records.Compat (HasField, getField, setField)
import GHC.Stack.Types qualified
-import GHC.TypeLits (Symbol)
import Quasar.Utils.ExtraT
io :: IO a -> IO a
diff --git a/test/Quasar/ResourceManagerSpec.hs b/test/Quasar/ResourceManagerSpec.hs
index 6ec68ee..ab8445b 100644
--- a/test/Quasar/ResourceManagerSpec.hs
+++ b/test/Quasar/ResourceManagerSpec.hs
@@ -65,7 +65,20 @@ spec = parallel $ do
liftIO $ throwIO TestException
\TestException -> True
+ it "handles an exception while disposing" $ io do
+ (`shouldThrow` \(_ :: CombinedException) -> True) do
+ withRootResourceManager do
+ registerDisposeAction $ throwIO TestException
+ liftIO $ threadDelay 100000
+
it "passes an exception to the root resource manager" $ io do
+ (`shouldThrow` \(_ :: CombinedException) -> True) do
+ withRootResourceManager do
+ withSubResourceManagerM do
+ registerDisposeAction $ throwIO TestException
+ liftIO $ threadDelay 100000
+
+ it "passes an exception to the root resource manager when closing the inner resource manager first" $ io do
(`shouldThrow` \(_ :: CombinedException) -> True) do
withRootResourceManager do
withSubResourceManagerM do
--
GitLab