blob: aa83e317388dedf4185881169360c811ddf3792c (
plain)
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
|
import Control.Concurrent
import Control.Exception
import GHC.Conc
import Foreign
-- test that putMVar blocks on a full MVar rather than raising an
-- exception.
main = do
-- In this test we want a thread to get BlockedIndefinitely; that
-- can't be the main thread because in GHCi the main thread
-- doesn't get BlockedIndefinitely. So we have to use a
-- subthread, and "prevent* the main thread from getting
-- BlockedIndefinitely when we're not in GHCi, which is what the
-- following hack does:
myThreadId >>= newStablePtr
m <- newEmptyMVar
t <- forkIO $ do
Control.Exception.catch (do
m <- newMVar ()
putMVar m ()
)
(\e -> putMVar m (e::SomeException))
takeMVar m >>= print
-- should print "thread blocked indefinitely"
|
