From 5095609d3baf3a645de0411c499d22ab68d4ec9a Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 31 Aug 2021 23:46:12 +0200
Subject: [PATCH] Add tests for cacheAwaitable
---
quasar.cabal | 2 ++
test/Quasar/AwaitableSpec.hs | 62 ++++++++++++++++++++++++++++++++++--
2 files changed, 62 insertions(+), 2 deletions(-)
diff --git a/quasar.cabal b/quasar.cabal
index 6c5b8dd..06c26ca 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -101,8 +101,10 @@ test-suite quasar-test
type: exitcode-stdio-1.0
build-depends:
base >=4.7 && <5,
+ exceptions,
hspec,
quasar,
+ stm,
unordered-containers,
main-is: Spec.hs
other-modules:
diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs
index e2b7c45..5045643 100644
--- a/test/Quasar/AwaitableSpec.hs
+++ b/test/Quasar/AwaitableSpec.hs
@@ -1,10 +1,17 @@
module Quasar.AwaitableSpec (spec) where
import Control.Concurrent
-import Control.Monad (void)
-import Prelude
+import Control.Concurrent.STM
+import Control.Monad.Catch
+import GHC.Conc (unsafeIOToSTM)
import Test.Hspec
import Quasar.Awaitable
+import Quasar.Prelude
+
+data TestException = TestException
+ deriving stock (Eq, Show)
+
+instance Exception TestException
spec :: Spec
spec = parallel $ do
@@ -55,3 +62,54 @@ spec = parallel $ do
threadDelay 100000
putAsyncVar_ avar2 ()
awaitAny2 avar1 avar2
+
+ describe "cacheAwaitable" do
+ it "can cache an awaitable" $ io do
+ var <- newTVarIO (0 :: Int)
+ awaitable <- cacheAwaitable do
+ unsafeAwaitSTM (modifyTVar var (+ 1)) :: Awaitable ()
+ await awaitable
+ await awaitable
+ readTVarIO var `shouldReturn` 1
+
+ it "can cache a bind" $ io do
+ var1 <- newTVarIO (0 :: Int)
+ var2 <- newTVarIO (0 :: Int)
+ awaitable <- cacheAwaitable do
+ unsafeAwaitSTM (modifyTVar var1 (+ 1)) >>= \_ -> unsafeAwaitSTM (modifyTVar var2 (+ 1)) :: Awaitable ()
+ await awaitable
+ await awaitable
+ readTVarIO var1 `shouldReturn` 1
+ readTVarIO var2 `shouldReturn` 1
+
+ it "can cache an exception" $ io do
+ var <- newMVar (0 :: Int)
+ awaitable <- cacheAwaitable do
+ unsafeAwaitSTM (unsafeIOToSTM (modifyMVar_ var (pure . (+ 1))) >> throwM TestException) :: Awaitable ()
+ await awaitable `shouldThrow` \TestException -> True
+ await awaitable `shouldThrow` \TestException -> True
+ readMVar var `shouldReturn` 1
+
+ it "can cache the left side of an awaitAny2" $ io do
+ var <- newTVarIO (0 :: Int)
+
+ let a1 = unsafeAwaitSTM (modifyTVar var (+ 1)) :: Awaitable ()
+ let a2 = unsafeAwaitSTM retry :: Awaitable ()
+
+ awaitable <- cacheAwaitable $ (awaitAny2 a1 a2 :: Awaitable ())
+
+ await awaitable
+ await awaitable
+ readTVarIO var `shouldReturn` 1
+
+ it "can cache the right side of an awaitAny2" $ io do
+ var <- newTVarIO (0 :: Int)
+
+ let a1 = unsafeAwaitSTM retry :: Awaitable ()
+ let a2 = unsafeAwaitSTM (modifyTVar var (+ 1)) :: Awaitable ()
+
+ awaitable <- cacheAwaitable $ (awaitAny2 a1 a2 :: Awaitable ())
+
+ await awaitable
+ await awaitable
+ readTVarIO var `shouldReturn` 1
--
GitLab