1 files changed, 27 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/4262.hs b/testsuite/tests/concurrent/should_run/4262.hs
new file mode 100644
index 0000000000..e114b558a6
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/4262.hs
@@ -0,0 +1,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