[Haskell-cafe] forkProcess, forkIO, and multithreaded runtime

[Michael Snoyman]

Hi all,

I think I have a misunderstanding of how forkProcess should be working.
Ultimately this relates to some bugs in the development version of keter,
but I've found some behavior in a simple test program which I wouldn't have
expected either, which may or may not be related.

With the program at the end of this email, I would expect that, once per
second, I would get a message printed from each forkIO'd green thread, the
forked process, and the master process. And if I spawn 8 or less child
threads that's precisely what happens. However, as soon as I up that number
to 9, the child process is never run. The process is, however, created, as
can be confirmed by looking at the process table.

This only occurs when using the multithreaded runtime. In other words,
compiling with "ghc --make test.hs" seems to always produce the expected
output, whereas "ghc --make -threaded test.hs" causes the behavior
described above. Having looked through the code for the process package a
bit, my initial guess is that this is being caused by a signal being sent
to the child process, but I'm not familiar enough with the inner workings
to confirm or disprove this guess.

If anyone has any ideas on this, I'd appreciate it.

Michael

import System.Posix.Process (forkProcess, getProcessID)
import Control.Concurrent (forkIO, threadDelay)
import System.IO (hFlush, stdout)
import System.Posix.Signals (signalProcess, sigKILL)
import Control.Exception (finally)

main :: IO ()
main = do
    mapM_ spawnChild [1..9]
    child <- forkProcess $ do
        putStrLn "starting child"
        hFlush stdout
        loop "child" 0
    print ("child pid", child)
    hFlush stdout

    -- I've commented out the "finally" so that the zombie process stays
alive,
    -- to prove that it was actually created.
    loop "parent" 0 -- `finally` signalProcess sigKILL child

spawnChild :: Int -> IO ()
spawnChild i = do
    _ <- forkIO $ loop ("spawnChild " ++ show i) 0
    return ()

loop :: String -> Int -> IO ()
loop msg i = do
    pid <- getProcessID
    print (pid, msg, i)
    hFlush stdout
    threadDelay 1000000
    loop msg (i + 1)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20121015/5ba1d547/attachment.htm>