summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/concurrent/should_run/conc037.hs
blob: 7da76f50259fceb0170c243262a961bcbf85d51c (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
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import Control.Concurrent

#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 200000  -- make sure the newly created thread is run.
  putStrLn "mainThread"
  x <- takeMVar th
  putStrLn x
  putStrLn "\nshutting down"