1 files changed, 28 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc040.hs b/testsuite/tests/concurrent/should_run/conc040.hs
new file mode 100644
index 0000000000..be3bfdb915
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/conc040.hs
@@ -0,0 +1,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!")