1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.Async.IO
( ioTestGroup
) where
import Control.Monad (when, void)
import Data.Maybe (isJust, isNothing)
import Control.Concurrent.Lifted
import Control.Exception.Lifted as E
#if MIN_VERSION_monad_control(1, 0, 0)
import Control.Concurrent.Async.Lifted.Safe
#else
import Control.Concurrent.Async.Lifted
#endif
import Test.Async.Common
ioTestGroup :: TestTree
ioTestGroup = $(testGroupGenerator)
case_async_waitCatch :: Assertion
case_async_waitCatch = do
a <- async (return value)
r <- waitCatch a
case r of
Left _ -> assertFailure ""
Right e -> e @?= value
case_async_wait :: Assertion
case_async_wait = do
a <- async (return value)
r <- wait a
assertEqual "async_wait" r value
case_async_exwaitCatch :: Assertion
case_async_exwaitCatch = do
a <- async (throwIO TestException)
r <- waitCatch a
case r of
Left e -> fromException e @?= Just TestException
Right _ -> assertFailure ""
case_async_exwait :: Assertion
case_async_exwait = do
a <- async (throwIO TestException)
(wait a >> assertFailure "") `E.catch` \e -> e @?= TestException
case_withAsync_waitCatch :: Assertion
case_withAsync_waitCatch = do
withAsync (return value) $ \a -> do
r <- waitCatch a
case r of
Left _ -> assertFailure ""
Right e -> e @?= value
case_withAsync_wait2 :: Assertion
case_withAsync_wait2 = do
a <- withAsync (threadDelay 1000000) $ return
r <- waitCatch a
case r of
Left e -> fromException e @?= Just AsyncCancelled
Right _ -> assertFailure ""
case_async_cancel :: Assertion
case_async_cancel = sequence_ $ replicate 1000 run
where
run = do
a <- async (return value)
cancelWith a TestException
r <- waitCatch a
case r of
Left e -> fromException e @?= Just TestException
Right r' -> r' @?= value
case_async_poll :: Assertion
case_async_poll = do
a <- async (threadDelay 1000000)
r <- poll a
when (isJust r) $ assertFailure ""
r' <- poll a -- poll twice, just to check we don't deadlock
when (isJust r') $ assertFailure ""
case_async_poll2 :: Assertion
case_async_poll2 = do
a <- async (return value)
void $ wait a
r <- poll a
when (isNothing r) $ assertFailure ""
r' <- poll a -- poll twice, just to check we don't deadlock
when (isNothing r') $ assertFailure ""
|
