1 files changed, 32 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/foreignInterruptible.hs b/testsuite/tests/concurrent/should_run/foreignInterruptible.hs
new file mode 100644
index 0000000000..32252fb8db
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/foreignInterruptible.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# OPTIONS -cpp #-}
+module Main where
+
+import Control.Concurrent
+import Control.Exception
+import Prelude hiding (catch)
+import Foreign
+import System.IO
+
+#ifdef mingw32_HOST_OS
+sleep n = sleepBlock (n*1000)
+foreign import stdcall interruptible "Sleep" sleepBlock :: Int -> IO ()
+#else
+sleep n = sleepBlock n
+foreign import ccall interruptible "sleep" sleepBlock :: Int -> IO ()
+#endif
+
+main :: IO ()
+main = do
+  newStablePtr stdout -- prevent stdout being finalized
+  th <- newEmptyMVar
+  tid <- forkIO $ do
+     putStrLn "newThread started"
+     (sleep 2 >> putStrLn "fail") `catch` (\ThreadKilled -> putStrLn "pass")
+     putMVar th "child"
+  yield
+  threadDelay 500000
+  killThread tid
+  x <- takeMVar th
+  putStrLn x
+  putStrLn "\nshutting down"