Ticket #8343: 0001-Fix-deadlock-in-readProcess-and-readProcessWithExitC.patch

File 0001-Fix-deadlock-in-readProcess-and-readProcessWithExitC.patch, 2.7 KB (added by akio, 2 years ago)

proposed patch

  • System/Process.hs

    From d31ea9af144acfb4717e7d57c32109c7dc0b5086 Mon Sep 17 00:00:00 2001
    From: Takano Akio <[email protected]>
    Date: Wed, 25 Sep 2013 19:37:00 +0900
    Subject: [PATCH] Fix deadlock in readProcess and readProcessWithExitCode
     (#8343)
    
    ---
     System/Process.hs  | 8 ++++----
     tests/T8343.hs     | 8 ++++++++
     tests/T8343.stdout | 2 ++
     tests/all.T        | 2 ++
     4 files changed, 16 insertions(+), 4 deletions(-)
     create mode 100644 tests/T8343.hs
     create mode 100644 tests/T8343.stdout
    
    diff --git a/System/Process.hs b/System/Process.hs
    index 42d2fac..2808339 100644
    a b readProcess cmd args input = 
    400400                                       std_out = CreatePipe,
    401401                                       std_err = Inherit }
    402402      flip onException
    403         (do hClose inh; hClose outh;
    404             terminateProcess pid; waitForProcess pid) $ restore $ do
     403        (do terminateProcess pid; hClose inh; hClose outh;
     404            waitForProcess pid) $ restore $ do
    405405        -- fork off a thread to start consuming the output
    406406        output  <- hGetContents outh
    407407        waitOut <- forkWait $ C.evaluate $ rnf output
    readProcessWithExitCode cmd args input = 
    457457                                                     std_out = CreatePipe,
    458458                                                     std_err = CreatePipe }
    459459      flip onException
    460         (do hClose inh; hClose outh; hClose errh;
    461             terminateProcess pid; waitForProcess pid) $ restore $ do
     460        (do terminateProcess pid; hClose inh; hClose outh; hClose errh;
     461            waitForProcess pid) $ restore $ do
    462462        -- fork off a thread to start consuming stdout
    463463        out <- hGetContents outh
    464464        waitOut <- forkWait $ C.evaluate $ rnf out
  • new file tests/T8343.hs

    diff --git a/tests/T8343.hs b/tests/T8343.hs
    new file mode 100644
    index 0000000..23363a5
    - +  
     1import System.Process
     2import System.Timeout
     3
     4main = timeout 1000000 $ do -- The outer timeout shouldn't trigger
     5  timeout 10000 $ print =<< readProcess "sleep" ["7200"] ""
     6  putStrLn "Good!"
     7  timeout 10000 $ print =<< readProcessWithExitCode "sleep" ["7200"] ""
     8  putStrLn "Good!"
  • new file tests/T8343.stdout

    diff --git a/tests/T8343.stdout b/tests/T8343.stdout
    new file mode 100644
    index 0000000..75c573d
    - +  
     1Good!
     2Good!
  • tests/all.T

    diff --git a/tests/all.T b/tests/all.T
    index 3a19367..f77fe8e 100644
    a b test('T4889', normal, compile_and_run, ['']) 
    3232
    3333test('process009', when(opsys('mingw32'), skip), compile_and_run, [''])
    3434test('process010', normal, compile_and_run, [''])
     35
     36test('T8343', normal, compile_and_run, [''])