git.iko.soy/effectful
on master help sign in
Add a few async tests
fbc5b30Andrzej Rybczak
effectful.cabal+1
compare with master
unifiedsplit
@@ -92,6 +92,7 @@ test-suite test
92 ghc-options: -threaded -rtsopts -with-rtsopts=-N4
92 ghc-options: -threaded -rtsopts -with-rtsopts=-N4
93
93
94 build-depends: base <5
94 build-depends: base <5
95+ , containers
95 , effectful
96 , effectful
96 , exceptions
97 , exceptions
97 , lifted-base
98 , lifted-base
tests/AsyncTests.hs+46−7
@@ -1,26 +1,33 @@
1module AsyncTests (asyncTests) where
1module AsyncTests (asyncTests) where
2
2
3+import Control.Concurrent (threadDelay)
4+import Control.Monad
5+import Control.Monad.IO.Class
3import Test.Tasty
6import Test.Tasty
4import Test.Tasty.HUnit
7import Test.Tasty.HUnit
8+import qualified Data.Set as S
5
9
6import Effectful.Async
10import Effectful.Async
11+import Effectful.Error
7import Effectful.State.Dynamic
12import Effectful.State.Dynamic
8import Effectful.Monad
13import Effectful.Monad
9−import Utils
14+import qualified Utils as U
10
15
11asyncTests :: TestTree
16asyncTests :: TestTree
12asyncTests = testGroup "Async"
17asyncTests = testGroup "Async"
13− [ testCase "thread local state" test_threadLocalState
18+ [ testCase "local state" test_localState
19+ , testCase "shared state" test_sharedState
20+ , testCase "error handling" test_errorHandling
14 ]
21 ]
15
22
16−test_threadLocalState :: Assertion
23+test_localState :: Assertion
17−test_threadLocalState = runIOE . evalState x $ do
24+test_localState = runIOE . runAsyncE . evalState x $ do
18− runAsyncE . replicateConcurrently_ 2 $ do
25+ replicateConcurrently_ 2 $ do
19 r <- goDownward 0
26 r <- goDownward 0
20− assertEqual_ "x = n" x r
27+ U.assertEqual "expected result" x r
21 where
28 where
22 x :: Int
29 x :: Int
23− x = 1000000
30+ x = 100000
24
31
25 goDownward :: State Int :> es => Int -> Eff es Int
32 goDownward :: State Int :> es => Int -> Eff es Int
26 goDownward acc = do
33 goDownward acc = do
@@ -30,3 +37,35 @@ test_threadLocalState = runIOE . evalState x $ do
30 if end
37 if end
31 then pure acc
38 then pure acc
32 else goDownward $ acc + 1
39 else goDownward $ acc + 1
40+
41+test_sharedState :: Assertion
42+test_sharedState = runIOE . runAsyncE . evalStateMVar (S.empty @Int) $ do
43+ concurrently_ (addWhen even x) (addWhen odd x)
44+ U.assertEqual "expected result" (S.fromList [1..x]) =<< get
45+ where
46+ x :: Int
47+ x = 100
48+
49+ addWhen :: State (S.Set Int) :> es => (Int -> Bool) -> Int -> Eff es ()
50+ addWhen f = \case
51+ 0 -> pure ()
52+ n -> do
53+ when (f n) $ do
54+ modify $ S.insert n
55+ addWhen f $ n - 1
56+
57+test_errorHandling :: Assertion
58+test_errorHandling = runIOE . runAsyncE . evalStateMVar (0::Int) $ do
59+ r <- runError $ concurrently_
60+ (liftIO (threadDelay 10000) >> throwError err)
61+ (modify (+x))
62+ case r of
63+ Left (_, e) -> U.assertEqual "error caught" err e
64+ Right _ -> U.assertFailure "error not caught"
65+ U.assertEqual "state updated" x =<< get
66+ where
67+ x :: Int
68+ x = 67
69+
70+ err :: String
71+ err = "thrown from async"
tests/StateTests.hs+15−15
@@ -9,7 +9,7 @@ import qualified UnliftIO.Exception as UE
9import Effectful.Interpreter
9import Effectful.Interpreter
10import Effectful.State.Dynamic
10import Effectful.State.Dynamic
11import Effectful.Monad
11import Effectful.Monad
12−import Utils
12+import qualified Utils as U
13
13
14stateTests :: TestTree
14stateTests :: TestTree
15stateTests = testGroup "State"
15stateTests = testGroup "State"
@@ -24,19 +24,19 @@ stateTests = testGroup "State"
24test_runState :: Assertion
24test_runState :: Assertion
25test_runState = runIOE $ do
25test_runState = runIOE $ do
26 (end, len) <- runState (0::Int) . execState collatzStart $ collatz
26 (end, len) <- runState (0::Int) . execState collatzStart $ collatz
27− assertEqual_ "correct end" 1 end
27+ U.assertEqual "correct end" 1 end
28− assertEqual_ "correct len" collatzLength len
28+ U.assertEqual "correct len" collatzLength len
29
29
30test_evalState :: Assertion
30test_evalState :: Assertion
31test_evalState = runIOE $ do
31test_evalState = runIOE $ do
32 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
32 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
33− assertEqual_ "correct len" collatzLength len
33+ U.assertEqual "correct len" collatzLength len
34
34
35test_stateM :: Assertion
35test_stateM :: Assertion
36test_stateM = runIOE $ do
36test_stateM = runIOE $ do
37 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
37 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
38− assertEqual_ "correct a" "hi" a
38+ U.assertEqual "correct a" "hi" a
39− assertEqual_ "correct b" "hi!!!" b
39+ U.assertEqual "correct b" "hi!!!" b
40
40
41test_deepStack :: Assertion
41test_deepStack :: Assertion
42test_deepStack = runIOE $ do
42test_deepStack = runIOE $ do
@@ -48,7 +48,7 @@ test_deepStack = runIOE $ do
48 modify @Int (+2)
48 modify @Int (+2)
49 modify @Int (+4)
49 modify @Int (+4)
50 modify @Int (+8)
50 modify @Int (+8)
51− assertEqual_ "n" 15 n
51+ U.assertEqual "n" 15 n
52
52
53test_exceptions :: Assertion
53test_exceptions :: Assertion
54test_exceptions = runIOE $ do
54test_exceptions = runIOE $ do
@@ -61,28 +61,28 @@ test_exceptions = runIOE $ do
61 where
61 where
62 testTry
62 testTry
63 :: String
63 :: String
64− -> (forall a es. IOE :> es => Eff es a -> Eff es (Either Ex a))
64+ -> (forall a es. IOE :> es => Eff es a -> Eff es (Either U.Ex a))
65 -> Eff '[IOE] ()
65 -> Eff '[IOE] ()
66 testTry lib tryImpl = do
66 testTry lib tryImpl = do
67 e <- tryImpl $ runState (0::Int) action
67 e <- tryImpl $ runState (0::Int) action
68− assertEqual_ (lib ++ " - exception caught") e (Left Ex)
68+ U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)
69 s <- execState (0::Int) $ tryImpl action
69 s <- execState (0::Int) $ tryImpl action
70− assertEqual_ (lib ++ " - state partially updated") s 1
70+ U.assertEqual (lib ++ " - state partially updated") s 1
71
71
72 testCatch
72 testCatch
73 :: String
73 :: String
74− -> (forall a es. IOE :> es => Eff es a -> (Ex -> Eff es a) -> Eff es a)
74+ -> (forall a es. IOE :> es => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
75 -> Eff '[IOE] ()
75 -> Eff '[IOE] ()
76 testCatch lib catchImpl = do
76 testCatch lib catchImpl = do
77 s <- execState (0::Int) $ do
77 s <- execState (0::Int) $ do
78− _ <- (evalState () action) `catchImpl` \Ex -> modify @Int (+4)
78+ _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)
79 modify @Int (+8)
79 modify @Int (+8)
80− assertEqual_ (lib ++ " - state correctly updated") s 13
80+ U.assertEqual (lib ++ " - state correctly updated") s 13
81
81
82 action :: State Int :> es => Eff es ()
82 action :: State Int :> es => Eff es ()
83 action = do
83 action = do
84 modify @Int (+1)
84 modify @Int (+1)
85− _ <- E.throwM Ex
85+ _ <- E.throwM U.Ex
86 modify @Int (+2)
86 modify @Int (+2)
87
87
88test_localEffects :: Assertion
88test_localEffects :: Assertion
@@ -94,7 +94,7 @@ test_localEffects = runIOE $ do
94 execState () $ do
94 execState () $ do
95 putInt expected
95 putInt expected
96 getInt
96 getInt
97− assertEqual_ "correct x" expected x
97+ U.assertEqual "correct x" expected x
98 where
98 where
99 expected :: Int
99 expected :: Int
100 expected = 4
100 expected = 4
tests/Utils.hs+21−4
@@ -1,13 +1,30 @@
1−module Utils where
1+module Utils
2+ ( assertBool
3+ , assertEqual
4+ , assertFailure
5+ , Ex(..)
6+ ) where
2
7
3import Control.Exception
8import Control.Exception
4import Control.Monad.IO.Class
9import Control.Monad.IO.Class
10+import GHC.Stack
5−import Test.Tasty.HUnit
11+import qualified Test.Tasty.HUnit as T
6
12
7import Effectful.Monad
13import Effectful.Monad
8
14
15+assertBool :: (HasCallStack, IOE :> es) => String -> Bool -> Eff es ()
16+assertBool msg p = liftIO $ T.assertBool msg p
17+
18+assertEqual
9−assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()
19+ :: (HasCallStack, Eq a, Show a, IOE :> es)
20+ => String
21+ -> a
22+ -> a
23+ -> Eff es ()
10−assertEqual_ msg expected given = liftIO $ assertEqual msg expected given
24+assertEqual msg expected given = liftIO $ T.assertEqual msg expected given
25+
26+assertFailure :: (HasCallStack, IOE :> es) => String -> Eff es a
27+assertFailure msg = liftIO $ T.assertFailure msg
11
28
12data Ex = Ex deriving (Eq, Show)
29data Ex = Ex deriving (Eq, Show)
13instance Exception Ex
30instance Exception Ex