#1461: System.Process.runInteractiveProcess leaks memory
-----------------------------+----------------------------------------------
  Reporter:  guest           |          Owner:       
      Type:  bug             |         Status:  new  
  Priority:  normal          |      Milestone:       
 Component:  libraries/base  |        Version:  6.6.1
  Severity:  normal          |       Keywords:       
Difficulty:  Unknown         |             Os:  Linux
  Testcase:                  |   Architecture:  x86  
-----------------------------+----------------------------------------------
Hi!

 I just discovered that using System.Process.runInteractiveProcess will
 produce a process with steady and linear memory consumption increase over
 time.

 While runInteractiveCommand does use the same imported function, still it
 is not affected by the problem.
 The code below offer a clear demonstration. With the first main (main')
 memory will stabilize (I gave the number I get on my system). With the
 second one, memory consumption will keep on increasing.

 All the best.
 Andrea Rossato
 [EMAIL PROTECTED]

 {{{
 module Main where

 import System.Process
 import System.Posix.IO
 import System.IO
 import Control.Concurrent

 readOutput rh =
     do str <- hGetLine rh
        return str

 runWith c f =
  do (i,o,e,p) <- f c
     exit <- waitForProcess p
     str <- readOutput o
     putStrLn str
     cHandles i o e
     threadDelay $ 100000 * 1
     runWith c f

 runRunIntProcess c =
     do (inp,out,err,p) <- runInteractiveProcess c [] Nothing Nothing
        return (inp,out,err,p)

 runRunIntCommand c =
     do (inp,out,err,p) <- runInteractiveCommand c
        return (inp,out,err,p)

 cHandles i o e =
     do hClose i
        hClose o
        hClose e


 -- this does not leaks
 -- top output (virtual, residen and sharde memory)
 --5528 3404  668 S  6.6  0.7  13:07.48 procRunInComm
 main' = runWith "date" runRunIntCommand

 -- This leaks
 -- top output (virtual, residen and sharde memory)
 --10548 8436  676 S  8.6  1.6  13:15.24 procRunInProc
 main = runWith "date" runRunIntProcess
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/1461>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to