Commit 583a28b2 authored by Tilman Blumhagen's avatar Tilman Blumhagen
Browse files

Added getPid

parent d17cda73
......@@ -46,6 +46,8 @@ module System.Process (
-- ** Related utilities
showCommandForUser,
Pid,
getPid,
-- ** Control-C handling on Unix
-- $ctlc-handling
......@@ -87,13 +89,25 @@ import System.Exit ( ExitCode(..) )
import System.IO
import System.IO.Error (mkIOError, ioeSetErrorString)
-- Provide the data constructors for CPid on GHC 7.4 and later
#if !defined(WINDOWS) && MIN_VERSION_base(4,5,0)
#if defined(WINDOWS)
import System.Win32.Process (getProcessId, ProcessId)
#else
import System.Posix.Types (CPid (..))
#endif
import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )
-- | The platform specific type for a process identifier.
--
-- This is always an integral type. Width and signedness are platform specific.
--
-- @since 1.6.3.0
#if defined(WINDOWS)
type Pid = ProcessId
#else
type Pid = CPid
#endif
-- ----------------------------------------------------------------------------
-- createProcess
......@@ -562,6 +576,31 @@ showCommandForUser :: FilePath -> [String] -> String
showCommandForUser cmd args = unwords (map translate (cmd : args))
-- ----------------------------------------------------------------------------
-- getPid
-- | Returns the PID (process ID) of a subprocess.
--
-- 'Nothing' is returned if the handle was already closed. Otherwise a
-- PID is returned that remains valid as long as the handle is open.
-- The operating system may reuse the PID as soon as the last handle to
-- the process is closed.
--
-- @since 1.6.3.0
getPid :: ProcessHandle -> IO (Maybe Pid)
getPid (ProcessHandle mh _ _) = do
p_ <- readMVar mh
case p_ of
#ifdef WINDOWS
OpenHandle h -> do
pid <- getProcessId h
return $ Just pid
#else
OpenHandle pid -> return $ Just pid
#endif
_ -> return Nothing
-- ----------------------------------------------------------------------------
-- waitForProcess
......
......@@ -2,6 +2,11 @@
## Unreleased changes
## 1.6.3.0 *November 2017*
* Added `getPid` and export of platform specific `Pid` type
[#109](https://github.com/haskell/process/pull/109)
## 1.6.2.0 *October 2017*
* Allow async exceptions to be delivered to masked thread calling `waitForProcess`
......
......@@ -5,9 +5,10 @@ import System.IO.Error
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Process
import Control.Concurrent
import Data.Char (isDigit)
import Data.List (isInfixOf)
import Data.Maybe (isNothing)
import System.IO (hClose, openBinaryTempFile)
import System.IO (hClose, openBinaryTempFile, hGetContents)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import System.Directory (getTemporaryDirectory, removeFile)
......@@ -94,6 +95,18 @@ main = do
Nothing -> return ()
Just ec -> error $ "waitForProcess not interrupted: sleep exited with " ++ show ec
putStrLn "testing getPid"
do
(_, Just out, _, p) <- createProcess $ (proc "sh" ["-c", "echo $$"]) {std_out = CreatePipe}
pid <- getPid p
line <- hGetContents out
putStrLn $ " queried PID: " ++ show pid
putStrLn $ " PID reported by stdout: " ++ show line
_ <- waitForProcess p
hClose out
let numStdoutPid = read (takeWhile isDigit line) :: Pid
unless (Just numStdoutPid == pid) $ error "subprocess reported unexpected PID"
putStrLn "Tests passed successfully"
withCurrentDirectory :: FilePath -> IO a -> IO a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment