[Haskell-beginners] System.Process.createProcess does not terminate

[John Obbele]

Hello everyones !

I was playing with some test frameworks recently and came across
what looks like a pseudo-fork bomb.

After digging things a little, it seems I am messing with the
System.Process.createProcess function : none of my spawned
process terminates and eventually my OS freezes. (trivia: well
now, I know that Fedora cannot handle more than 1100 processes on
my cheap laptop ^^)

I've attached a small haskell file which can easily reproduces my
problem. If you, carefully, run it from the GHCi prompt while
monitoring your pool of processes, you will probably see a
hundred of zombie processes appearing.

Has anyone got some clues on what's wrong with my function ? Is
it related to some strange lazy behavior or should I simply
manage each spawned process myself and terminate it when needed ?

regards,
/John

P.S.: speaking of test frameworks, I am desperate to find good
examples or documentations on how to use QuickCheck2. Where could
I get such resources ?
-------------- next part --------------
-- Be Careful when running this file
-- spawned processes could hang up your system

import System.Process
import System.IO

tr input = do 
    let (cmd, args) = ("tr", ["a-z", "A-Z"])
    let process = (proc cmd args){ std_in = CreatePipe
                                 , std_out = CreatePipe
                                 , close_fds = True }
    (Just hin, Just hout, _, _) <- createProcess process
    -- inject data
    hPutStr hin input
    hClose hin
    -- return (IO String)
    hGetContents hout

tr' input = do
    let process = (proc "tr" ["a-z", "A-Z"]){ std_in = CreatePipe
                                            , std_out = CreatePipe 
                                            , close_fds = True }
    (Just hin, Just hout, _, _) <- createProcess process
    -- inject data
    hPutStr hin input
    hClose hin
    -- return (IO String)
    putStr =<< hGetContents hout
    hClose hout

test00 = mapM_ (\_ -> tr "Homebrew fork-bomb\n" >>= putStr) [0..50]
test01 = mapM_ (\_ -> tr' "Homebrew fork-bomb\n") [0..50]

main = test00 >> test01 >> wait
  where wait = do putStrLn "Press any key to quit"
                  input <- getLine
                  putStrLn (">>" ++ input)