diff options
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc038.hs')
-rw-r--r-- | testsuite/tests/concurrent/should_run/conc038.hs | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc038.hs b/testsuite/tests/concurrent/should_run/conc038.hs new file mode 100644 index 0000000000..0cf82f3b24 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/conc038.hs @@ -0,0 +1,37 @@ +{-# OPTIONS_GHC -cpp #-} +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Control.Concurrent + +haskellFun :: Int -> IO () +haskellFun c = putStrLn ("Haskell: " ++ show c) + +foreign export ccall "hFun" haskellFun :: Int -> IO () +foreign import ccall safe "hFun" hFun :: Int -> IO () + +#ifdef mingw32_HOST_OS +foreign import stdcall safe "Sleep" _sleepBlock :: Int -> IO () +sleepBlock n = _sleepBlock (n*1000) +#else +foreign import ccall safe "sleep" sleepBlock :: Int -> IO () +#endif + + + +main :: IO () +main = do + th <- newEmptyMVar + forkIO $ do + putStrLn "newThread started" + sleepBlock 1 + putStrLn "newThread back again" + putMVar th "1 sec later" + threadDelay 500000 >> putStrLn "mainThread" + -- this will not be blocked in the threaded RTS + forkIO $ (hFun 2) + -- neither will this + x <- takeMVar th + putStrLn x + putStrLn "\nshutting down" + |