blob: be3bfdb9151263675362ea8704bfabf159741a52 (
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
27
28
|
{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign
import Data.IORef
import Control.Concurrent
import Control.Exception
foreign import ccall "wrapper"
wrap :: IO () -> IO (FunPtr (IO ()))
foreign import ccall "dynamic"
invoke :: FunPtr (IO ()) -> IO ()
{-# NOINLINE m #-}
m :: IORef ThreadId
m = unsafePerformIO (newIORef (error "m"))
main = do
id <- myThreadId
writeIORef m id
raise' <- wrap raise
invoke raise'
raise = do
id <- readIORef m
me <- myThreadId
forkIO $ do threadDelay 10000; throwTo me (ErrorCall "timeout")
throwTo id (ErrorCall "kapow!")
|
