blob: e114b558a6dd989983c09a7308d337b26595a4a6 (
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
|
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
-- Tests that superfluous worker threads are discarded rather than
-- being kept around by the RTS.
import Control.Concurrent
import Control.Monad
import Foreign.C.Types
import System.Mem
import System.Posix.Process
import System.Directory
import Control.Concurrent.QSem
foreign import ccall safe sleep :: CUInt -> IO ()
main = do
let amount = 200
qsem <- newQSem 0
replicateM_ amount . forkIO $ (sleep 2 >> signalQSem qsem)
replicateM_ amount $ waitQSem qsem
-- POSIX only: check thread usage manually
pid <- getProcessID
let dir = "/proc/" ++ show pid ++ "/task"
contents <- getDirectoryContents dir
let status = length contents - 2 -- . and ..
print status
|
