[commit: packages/process] less-cpp, master: Move interruptProcessGroupOf into per-OS modules (6a8ca1e)
git at git.haskell.org
git at git.haskell.org
Tue Dec 15 13:34:43 UTC 2015
Repository : ssh://git@git.haskell.org/process
On branches: less-cpp,master
Link : http://ghc.haskell.org/trac/ghc/changeset/6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687/process
>---------------------------------------------------------------
commit 6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687
Author: Michael Snoyman <michael at fpcomplete.com>
Date: Mon Nov 2 17:02:44 2015 +0000
Move interruptProcessGroupOf into per-OS modules
>---------------------------------------------------------------
6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687
System/Process.hsc | 38 --------------------------------------
System/Process/Internals.hs | 17 +++++++++++++++++
System/Process/Posix.hs | 13 +++++++++++++
System/Process/Windows.hs | 23 +++++++++++++++++++++++
4 files changed, 53 insertions(+), 38 deletions(-)
diff --git a/System/Process.hsc b/System/Process.hsc
index c0b08ee..de07225 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -90,7 +90,6 @@ import System.IO.Error (mkIOError, ioeSetErrorString)
#if defined(mingw32_HOST_OS)
# include <fcntl.h> /* for _O_BINARY */
#else
-import System.Posix.Process (getProcessGroupIDOf)
#if MIN_VERSION_base(4,5,0)
import System.Posix.Types
#endif
@@ -98,12 +97,6 @@ import System.Posix.Types
#ifdef __GLASGOW_HASKELL__
import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )
-# if defined(mingw32_HOST_OS)
-import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)
-import System.Win32.Process (getProcessId)
-# else
-import System.Posix.Signals
-# endif
#endif
-- ----------------------------------------------------------------------------
@@ -689,37 +682,6 @@ terminateProcess ph = do
-- ----------------------------------------------------------------------------
--- interruptProcessGroupOf
-
--- | Sends an interrupt signal to the process group of the given process.
---
--- On Unix systems, it sends the group the SIGINT signal.
---
--- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for
--- processes created using 'createProcess' and setting the 'create_group' flag
-
-interruptProcessGroupOf
- :: ProcessHandle -- ^ A process in the process group
- -> IO ()
-interruptProcessGroupOf ph = do
- withProcessHandle ph $ \p_ -> do
- case p_ of
- ClosedHandle _ -> return ()
- OpenHandle h -> do
-#if mingw32_HOST_OS
- pid <- getProcessId h
- generateConsoleCtrlEvent cTRL_BREAK_EVENT pid
--- We can't use an #elif here, because MIN_VERSION_unix isn't defined
--- on Windows, so on Windows cpp fails:
--- error: missing binary operator before token "("
-#else
- pgid <- getProcessGroupIDOf h
- signalProcessGroup sigINT pgid
-#endif
- return ()
-
-
--- ----------------------------------------------------------------------------
-- Interface to C bits
foreign import ccall unsafe "terminateProcess"
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 3a673c7..69ecd2b 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -42,6 +42,7 @@ module System.Process.Internals (
withFilePathException, withCEnvironment,
translate,
createPipe,
+ interruptProcessGroupOf,
) where
import Foreign.C
@@ -170,3 +171,19 @@ runGenProcess_ fun c _ _ = createProcess_ fun c
createPipe :: IO (Handle, Handle)
createPipe = createPipeInternal
{-# INLINE createPipe #-}
+
+
+-- ----------------------------------------------------------------------------
+-- interruptProcessGroupOf
+
+-- | Sends an interrupt signal to the process group of the given process.
+--
+-- On Unix systems, it sends the group the SIGINT signal.
+--
+-- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for
+-- processes created using 'createProcess' and setting the 'create_group' flag
+
+interruptProcessGroupOf
+ :: ProcessHandle -- ^ A process in the process group
+ -> IO ()
+interruptProcessGroupOf = interruptProcessGroupOfInternal
diff --git a/System/Process/Posix.hs b/System/Process/Posix.hs
index e9d1e31..a68d942 100644
--- a/System/Process/Posix.hs
+++ b/System/Process/Posix.hs
@@ -15,6 +15,7 @@ module System.Process.Posix
, c_execvpe
, pPrPr_disableITimers
, createPipeInternal
+ , interruptProcessGroupOfInternal
) where
import Control.Concurrent
@@ -36,6 +37,7 @@ import System.Posix.Internals
import GHC.IO.Exception
import System.Posix.Signals as Sig
import qualified System.Posix.IO as Posix
+import System.Posix.Process (getProcessGroupIDOf)
import System.Process.Common
@@ -280,3 +282,14 @@ createPipeInternal = do
readh <- Posix.fdToHandle readfd
writeh <- Posix.fdToHandle writefd
return (readh, writeh)
+
+interruptProcessGroupOfInternal
+ :: ProcessHandle -- ^ A process in the process group
+ -> IO ()
+interruptProcessGroupOfInternal ph = do
+ withProcessHandle ph $ \p_ -> do
+ case p_ of
+ ClosedHandle _ -> return ()
+ OpenHandle h -> do
+ pgid <- getProcessGroupIDOf h
+ signalProcessGroup sigINT pgid
diff --git a/System/Process/Windows.hs b/System/Process/Windows.hs
index 676ecbe..51a4c51 100644
--- a/System/Process/Windows.hs
+++ b/System/Process/Windows.hs
@@ -10,6 +10,7 @@ module System.Process.Windows
, stopDelegateControlC
, isDefaultSignal
, createPipeInternal
+ , interruptProcessGroupOfInternal
) where
import System.Process.Common
@@ -37,6 +38,8 @@ import GHC.IO.IOMode
import System.Directory ( doesFileExist )
import System.Environment ( getEnv )
import System.FilePath
+import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)
+import System.Win32.Process (getProcessId)
import System.Process.Common
@@ -262,3 +265,23 @@ foreign import ccall "io.h _pipe" c__pipe ::
foreign import ccall "io.h _close" c__close ::
CInt -> IO CInt
+
+interruptProcessGroupOfInternal
+ :: ProcessHandle -- ^ A process in the process group
+ -> IO ()
+interruptProcessGroupOfInternal ph = do
+ withProcessHandle ph $ \p_ -> do
+ case p_ of
+ ClosedHandle _ -> return ()
+ OpenHandle h -> do
+#if mingw32_HOST_OS
+ pid <- getProcessId h
+ generateConsoleCtrlEvent cTRL_BREAK_EVENT pid
+-- We can't use an #elif here, because MIN_VERSION_unix isn't defined
+-- on Windows, so on Windows cpp fails:
+-- error: missing binary operator before token "("
+#else
+ pgid <- getProcessGroupIDOf h
+ signalProcessGroup sigINT pgid
+#endif
+ return ()
More information about the ghc-commits
mailing list