Skip to content

Commit 0f7b948

Browse files
committed
Updated based on review
1 parent 523b3dd commit 0f7b948

File tree

6 files changed

+23
-30
lines changed

6 files changed

+23
-30
lines changed

System/Process.hs

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -596,8 +596,8 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do
596596
throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret)
597597
modifyProcessHandle ph $ \p_' ->
598598
case p_' of
599-
ClosedHandle e -> return (p_',e)
600-
OpenExtHandle{} -> error "waitForProcess handle mismatch."
599+
ClosedHandle e -> return (p_', e)
600+
OpenExtHandle{} -> return (p_', ExitFailure (-1))
601601
OpenHandle ph' -> do
602602
closePHANDLE ph'
603603
code <- peek pret
@@ -608,13 +608,13 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do
608608
when delegating_ctlc $
609609
endDelegateControlC e
610610
return e
611-
OpenExtHandle _ job iocp -> do
611+
OpenExtHandle _ job iocp ->
612612
#if defined(WINDOWS)
613613
maybe (ExitFailure (-1)) mkExitCode `fmap` waitForJobCompletion job iocp timeout_Infinite
614614
where mkExitCode code | code == 0 = ExitSuccess
615615
| otherwise = ExitFailure $ fromIntegral code
616616
#else
617-
error "OpenExtHandle should not happen on POSIX."
617+
return $ ExitFailure (-1)
618618
#endif
619619

620620
-- ----------------------------------------------------------------------------
@@ -635,14 +635,14 @@ getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do
635635
case p_ of
636636
ClosedHandle e -> return (p_, (Just e, False))
637637
open -> do
638-
let h = getHandle open
639638
alloca $ \pExitCode -> do
640-
res <- throwErrnoIfMinus1Retry "getProcessExitCode" $
641-
c_getProcessExitCode h pExitCode
642-
code <- peek pExitCode
639+
res <- let getCode h = throwErrnoIfMinus1Retry "getProcessExitCode" $
640+
c_getProcessExitCode h pExitCode
641+
in maybe (return 0) getCode $ getHandle open
643642
if res == 0
644643
then return (p_, (Nothing, False))
645644
else do
645+
code <- peek pExitCode
646646
closePHANDLE h
647647
let e | code == 0 = ExitSuccess
648648
| otherwise = ExitFailure (fromIntegral code)
@@ -651,10 +651,10 @@ getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do
651651
Just e | was_open && delegating_ctlc -> endDelegateControlC e
652652
_ -> return ()
653653
return m_e
654-
where getHandle :: ProcessHandle__ -> PHANDLE
655-
getHandle (OpenHandle h) = h
656-
getHandle (ClosedHandle _) = error "getHandle: handle closed."
657-
getHandle (OpenExtHandle h _ _) = h
654+
where getHandle :: ProcessHandle__ -> Maybe PHANDLE
655+
getHandle (OpenHandle h) = Just h
656+
getHandle (ClosedHandle _) = Nothing
657+
getHandle (OpenExtHandle h _ _) = Just h
658658

659659

660660
-- ----------------------------------------------------------------------------

System/Process/Common.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -101,11 +101,11 @@ data CreateProcess = CreateProcess{
101101
--
102102
-- @since 1.4.0.0
103103
use_process_jobs :: Bool -- ^ On Windows systems this flag indicates that we should wait for the entire process tree
104-
-- to finish before unblocking. On POSIX system this flag is ignored.
104+
-- to finish before unblocking. On POSIX systems this flag is ignored.
105105
--
106106
-- Default: @False@
107107
--
108-
-- @since 1.x.x.x
108+
-- @since 1.5.0.0
109109
} deriving (Show, Eq)
110110

111111
-- | contains the handles returned by a call to createProcess_Internal

System/Process/Internals.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -32,13 +32,13 @@ module System.Process.Internals (
3232
endDelegateControlC,
3333
stopDelegateControlC,
3434
unwrapHandles,
35-
#ifndef WINDOWS
36-
pPrPr_disableITimers, c_execvpe,
37-
ignoreSignal, defaultSignal,
38-
#else
35+
#ifdef WINDOWS
3936
terminateJob,
4037
waitForJobCompletion,
4138
timeout_Infinite,
39+
#else
40+
pPrPr_disableITimers, c_execvpe,
41+
ignoreSignal, defaultSignal,
4242
#endif
4343
withFilePathException, withCEnvironment,
4444
translate,
@@ -70,7 +70,7 @@ import System.Process.Posix
7070
-- * This function takes an extra @String@ argument to be used in creating
7171
-- error messages.
7272
--
73-
-- * 'use_process_jobs' can set in CreateProcess since 1.4.?.? in order to create
73+
-- * 'use_process_jobs' can be set in CreateProcess since 1.5.0.0 in order to create
7474
-- an I/O completion port to monitor a process tree's progress on Windows.
7575
--
7676
-- The function also returns two new handles:

System/Process/Windows.hsc

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -44,17 +44,10 @@ import System.Win32.Process (getProcessId)
4444

4545
-- The double hash is used so that hsc does not process this include file
4646
##include "processFlags.h"
47+
#include "windows_cconv.h"
4748

4849
#include <fcntl.h> /* for _O_BINARY */
4950

50-
##if defined(i386_HOST_ARCH)
51-
## define WINDOWS_CCONV stdcall
52-
##elif defined(x86_64_HOST_ARCH)
53-
## define WINDOWS_CCONV ccall
54-
##else
55-
## error Unknown mingw32 arch
56-
##endif
57-
5851
throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE
5952
throwErrnoIfBadPHandle = throwErrnoIfNull
6053

changelog.md

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,13 @@
55
* Bug fix: Don't close already closed pipes
66
[#81](https://github.com/haskell/process/pull/81)
77
* Relax version bounds of Win32 to allow 2.5.
8+
* Add support for monitoring process tree for termination with the parameter `use_process_jobs`
9+
in `CreateProcess` on Windows. Also added a function `terminateJob` to kill entire process tree.
810

911
## 1.4.3.0 *December 2016*
1012

1113
* New exposed `withCreateProcess`
1214
* Derive `Show` and `Eq` for `CreateProcess`, `CmdSpec`, and `StdStream`
13-
* Add support for monitoring process tree for termination with the parameter `use_process_jobs`
14-
in `CreateProcess` on Windows. Also added a function `terminateJob` to kill entire process tree.
1515

1616
## 1.4.2.0 *January 2016*
1717

process.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: process
2-
version: 1.4.3.1
2+
version: 1.5.0.0
33
-- NOTE: Don't forget to update ./changelog.md
44
license: BSD3
55
license-file: LICENSE

0 commit comments

Comments
 (0)