1 files changed, 29 insertions, 0 deletions
diff --git a/testsuite/tests/ffi/should_run/ffi014.hs b/testsuite/tests/ffi/should_run/ffi014.hs
new file mode 100644
index 0000000000..4434bef21a
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi014.hs
@@ -0,0 +1,29 @@
+-- exposed a bug in GHC 6.4 threaded RTS, fixed in Schedule.c rev. 1.232
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import Foreign.Ptr
+import Data.IORef
+
+main = do
+  ms <- replicateM 100 $ do putStrLn "." 
+       		      	    m <- newEmptyMVar 
+			    forkOS (thread >> putMVar m ())
+			    thread
+			    return m
+  mapM takeMVar ms
+
+thread = do var <- newIORef 0
+            let f = modifyIORef var (1+)
+            callC =<< mkFunc f
+
+type FUNC  =  IO ()
+
+foreign import ccall unsafe "wrapper"
+   mkFunc :: FUNC -> IO (FunPtr FUNC)
+
+foreign import ccall safe "ffi014_cbits.h callC"
+   callC:: FunPtr FUNC -> IO ()
+