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, 19 months 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, [''])