Commit 10f7cee4 authored by Simon Marlow's avatar Simon Marlow
Browse files

add test for #4262

parent ae959ec4
{-# 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
...@@ -43,6 +43,10 @@ test('async001', normal, compile_and_run, ['']) ...@@ -43,6 +43,10 @@ test('async001', normal, compile_and_run, [''])
test('numsparks001', only_ways(['threaded1']), compile_and_run, ['']) test('numsparks001', only_ways(['threaded1']), compile_and_run, [''])
test('4262', [ only_ways(['threaded1']),
unless_os('linux',skip) ],
compile_and_run, [''])
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
# These tests we only do for a full run # These tests we only do for a full run
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment