From c0372cc581c616a7160cc437a6d49f752661b31d Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 25 Aug 2021 03:00:48 +0200
Subject: [PATCH] Move async tests to the appropriate module
---
quasar.cabal | 1 +
test/Quasar/AsyncSpec.hs | 65 ++++++++++++++++++++++++++++++++++++
test/Quasar/AwaitableSpec.hs | 57 -------------------------------
3 files changed, 66 insertions(+), 57 deletions(-)
create mode 100644 test/Quasar/AsyncSpec.hs
diff --git a/quasar.cabal b/quasar.cabal
index 3022eef..497cfd3 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -102,6 +102,7 @@ test-suite quasar-test
unordered-containers,
main-is: Spec.hs
other-modules:
+ Quasar.AsyncSpec
Quasar.AwaitableSpec
Quasar.DisposableSpec
Quasar.ObservableSpec
diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs
new file mode 100644
index 0000000..6be9c58
--- /dev/null
+++ b/test/Quasar/AsyncSpec.hs
@@ -0,0 +1,65 @@
+module Quasar.AsyncSpec (spec) where
+
+import Control.Concurrent
+import Control.Monad (void)
+import Control.Monad.IO.Class
+import Prelude
+import Test.Hspec
+import Quasar.Async
+import Quasar.Awaitable
+import System.Timeout
+
+spec :: Spec
+spec = parallel $ do
+ describe "AsyncIO" $ do
+ it "binds pure operations" $ do
+ withDefaultAsyncManager (pure () >>= \() -> pure ())
+
+ it "binds IO actions" $ do
+ m1 <- newEmptyMVar
+ m2 <- newEmptyMVar
+ withDefaultAsyncManager (liftIO (putMVar m1 ()) >>= \() -> liftIO (putMVar m2 ()))
+ tryTakeMVar m1 `shouldReturn` Just ()
+ tryTakeMVar m2 `shouldReturn` Just ()
+
+ xit "can continue after awaiting an already finished operation" $ do
+ withDefaultAsyncManager (await =<< async (pure 42 :: AsyncIO Int)) `shouldReturn` 42
+
+ it "can await the result of an async that is completed later" $ do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ void $ forkIO $ do
+ threadDelay 100000
+ putAsyncVar_ avar ()
+ withDefaultAsyncManager (await avar)
+
+ it "can fmap the result of an already finished async" $ do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ putAsyncVar_ avar ()
+ withDefaultAsyncManager (id <$> await avar)
+
+ it "can fmap the result of an async that is completed later" $ do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ void $ forkIO $ do
+ threadDelay 100000
+ putAsyncVar_ avar ()
+ withDefaultAsyncManager (id <$> await avar)
+
+ it "can bind the result of an already finished async" $ do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ putAsyncVar_ avar ()
+ withDefaultAsyncManager (await avar >>= pure)
+
+ it "can bind the result of an async that is completed later" $ do
+ avar <- newAsyncVar :: IO (AsyncVar ())
+ void $ forkIO $ do
+ threadDelay 100000
+ putAsyncVar_ avar ()
+ withDefaultAsyncManager (await avar >>= pure)
+
+ xit "can terminate when encountering an asynchronous exception" $ do
+ never <- newAsyncVar :: IO (AsyncVar ())
+
+ result <- timeout 100000 $ withDefaultAsyncManager $
+ -- Use bind to create an AsyncIOPlumbing, which is the interesting case that uses `uninterruptibleMask` when run
+ await never >>= pure
+ result `shouldBe` Nothing
diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs
index cfba16f..eb5d3c1 100644
--- a/test/Quasar/AwaitableSpec.hs
+++ b/test/Quasar/AwaitableSpec.hs
@@ -2,12 +2,9 @@ module Quasar.AwaitableSpec (spec) where
import Control.Concurrent
import Control.Monad (void)
-import Control.Monad.IO.Class
import Prelude
import Test.Hspec
-import Quasar.Async
import Quasar.Awaitable
-import System.Timeout
spec :: Spec
spec = parallel $ do
@@ -58,57 +55,3 @@ spec = parallel $ do
threadDelay 100000
putAsyncVar_ avar2 ()
awaitIO (awaitAny2 avar1 avar2)
-
-
- describe "AsyncIO" $ do
- it "binds pure operations" $ do
- withDefaultAsyncManager (pure () >>= \() -> pure ())
-
- it "binds IO actions" $ do
- m1 <- newEmptyMVar
- m2 <- newEmptyMVar
- withDefaultAsyncManager (liftIO (putMVar m1 ()) >>= \() -> liftIO (putMVar m2 ()))
- tryTakeMVar m1 `shouldReturn` Just ()
- tryTakeMVar m2 `shouldReturn` Just ()
-
- xit "can continue after awaiting an already finished operation" $ do
- withDefaultAsyncManager (await =<< async (pure 42 :: AsyncIO Int)) `shouldReturn` 42
-
- it "can await the result of an async that is completed later" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- void $ forkIO $ do
- threadDelay 100000
- putAsyncVar_ avar ()
- withDefaultAsyncManager (await avar)
-
- it "can fmap the result of an already finished async" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- putAsyncVar_ avar ()
- withDefaultAsyncManager (id <$> await avar)
-
- it "can fmap the result of an async that is completed later" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- void $ forkIO $ do
- threadDelay 100000
- putAsyncVar_ avar ()
- withDefaultAsyncManager (id <$> await avar)
-
- it "can bind the result of an already finished async" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- putAsyncVar_ avar ()
- withDefaultAsyncManager (await avar >>= pure)
-
- it "can bind the result of an async that is completed later" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- void $ forkIO $ do
- threadDelay 100000
- putAsyncVar_ avar ()
- withDefaultAsyncManager (await avar >>= pure)
-
- xit "can terminate when encountering an asynchronous exception" $ do
- never <- newAsyncVar :: IO (AsyncVar ())
-
- result <- timeout 100000 $ withDefaultAsyncManager $
- -- Use bind to create an AsyncIOPlumbing, which is the interesting case that uses `uninterruptibleMask` when run
- await never >>= pure
- result `shouldBe` Nothing
--
GitLab