blob: e4acd84eef86eb544019e50a9fd90679729d870e (
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
29
|
{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign
import Data.IORef
import Control.Concurrent
import Control.Exception
import System.IO.Unsafe
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!")
|
