fbc5b30 · effectful · git.iko.soy

git.iko.soy/effectful

Add a few async tests

commitfbc5b30b74c7a1c746452efba8a57c16239a0541 authorAndrzej Rybczak <andrzej@rybczak.net> dateSun 27 Jun 2021, 00:13 (5 years ago) parent0d4109c

4 files changed+83−26

compare with master

unifiedsplit

effectful.cabal+1 tests/AsyncTests.hs+46−7 tests/StateTests.hs+15−15 tests/Utils.hs+21−4

effectful.cabal+1

@@ -92,6 +92,7 @@ test-suite test

9292 ghc-options: -threaded -rtsopts -with-rtsopts=-N4

9393

9494 build-depends: base <5

95+ , containers

9596 , effectful

9697 , exceptions

9798 , lifted-base

tests/AsyncTests.hs+46−7

@@ -1,26 +1,33 @@

11module AsyncTests (asyncTests) where

3+import Control.Concurrent (threadDelay)

4+import Control.Monad

5+import Control.Monad.IO.Class

36import Test.Tasty

47import Test.Tasty.HUnit

8+import qualified Data.Set as S

610import Effectful.Async

11+import Effectful.Error

712import Effectful.State.Dynamic

813import Effectful.Monad

9−import Utils

14+import qualified Utils as U

1015

1116asyncTests :: TestTree

1217asyncTests = 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

1421 ]

1522

16−test_threadLocalState :: Assertion

17−test_threadLocalState = runIOE . evalState x $ do

18− runAsyncE . replicateConcurrently_ 2 $ do

23+test_localState :: Assertion

24+test_localState = runIOE . runAsyncE . evalState x $ do

25+ replicateConcurrently_ 2 $ do

1926 r <- goDownward 0

20− assertEqual_ "x = n" x r

27+ U.assertEqual "expected result" x r

2128 where

2229 x :: Int

23− x = 1000000

30+ x = 100000

2431

2532 goDownward :: State Int :> es => Int -> Eff es Int

2633 goDownward acc = do

@@ -30,3 +37,35 @@ test_threadLocalState = runIOE . evalState x $ do

3037 if end

3138 then pure acc

3239 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

99import Effectful.Interpreter

1010import Effectful.State.Dynamic

1111import Effectful.Monad

12−import Utils

12+import qualified Utils as U

1313

1414stateTests :: TestTree

1515stateTests = testGroup "State"

@@ -24,19 +24,19 @@ stateTests = testGroup "State"

2424test_runState :: Assertion

2525test_runState = runIOE $ do

2626 (end, len) <- runState (0::Int) . execState collatzStart $ collatz

27− assertEqual_ "correct end" 1 end

28− assertEqual_ "correct len" collatzLength len

27+ U.assertEqual "correct end" 1 end

28+ U.assertEqual "correct len" collatzLength len

2929

3030test_evalState :: Assertion

3131test_evalState = runIOE $ do

3232 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int

33− assertEqual_ "correct len" collatzLength len

33+ U.assertEqual "correct len" collatzLength len

3434

3535test_stateM :: Assertion

3636test_stateM = runIOE $ do

3737 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")

38− assertEqual_ "correct a" "hi" a

39− assertEqual_ "correct b" "hi!!!" b

38+ U.assertEqual "correct a" "hi" a

39+ U.assertEqual "correct b" "hi!!!" b

4040

4141test_deepStack :: Assertion

4242test_deepStack = runIOE $ do

@@ -48,7 +48,7 @@ test_deepStack = runIOE $ do

4848 modify @Int (+2)

4949 modify @Int (+4)

5050 modify @Int (+8)

51− assertEqual_ "n" 15 n

51+ U.assertEqual "n" 15 n

5252

5353test_exceptions :: Assertion

5454test_exceptions = runIOE $ do

@@ -61,28 +61,28 @@ test_exceptions = runIOE $ do

6161 where

6262 testTry

6363 :: 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))

6565 -> Eff '[IOE] ()

6666 testTry lib tryImpl = do

6767 e <- tryImpl $ runState (0::Int) action

68− assertEqual_ (lib ++ " - exception caught") e (Left Ex)

68+ U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)

6969 s <- execState (0::Int) $ tryImpl action

70− assertEqual_ (lib ++ " - state partially updated") s 1

70+ U.assertEqual (lib ++ " - state partially updated") s 1

7171

7272 testCatch

7373 :: 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)

7575 -> Eff '[IOE] ()

7676 testCatch lib catchImpl = do

7777 s <- execState (0::Int) $ do

78− _ <- (evalState () action) `catchImpl` \Ex -> modify @Int (+4)

78+ _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)

7979 modify @Int (+8)

80− assertEqual_ (lib ++ " - state correctly updated") s 13

80+ U.assertEqual (lib ++ " - state correctly updated") s 13

8181

8282 action :: State Int :> es => Eff es ()

8383 action = do

8484 modify @Int (+1)

85− _ <- E.throwM Ex

85+ _ <- E.throwM U.Ex

8686 modify @Int (+2)

8787

8888test_localEffects :: Assertion

@@ -94,7 +94,7 @@ test_localEffects = runIOE $ do

9494 execState () $ do

9595 putInt expected

9696 getInt

97− assertEqual_ "correct x" expected x

97+ U.assertEqual "correct x" expected x

9898 where

9999 expected :: Int

100100 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

38import Control.Exception

49import Control.Monad.IO.Class

5−import Test.Tasty.HUnit

10+import GHC.Stack

11+import qualified Test.Tasty.HUnit as T

612

713import Effectful.Monad

814

9−assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()

10−assertEqual_ msg expected given = liftIO $ assertEqual msg expected given

15+assertBool :: (HasCallStack, IOE :> es) => String -> Bool -> Eff es ()

16+assertBool msg p = liftIO $ T.assertBool msg p

17+

18+assertEqual

19+ :: (HasCallStack, Eq a, Show a, IOE :> es)

20+ => String

21+ -> a

22+ -> a

23+ -> Eff es ()

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

1128

1229data Ex = Ex deriving (Eq, Show)

1330instance Exception Ex