[commit: packages/unix] master: `M-x untabify` & `M-x delete-trailing-whitespace` (a5aa36d)
git at git.haskell.org
git at git.haskell.org
Fri Nov 8 14:49:36 UTC 2013
Repository : ssh://git@git.haskell.org/unix
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a5aa36d7a86ccfea758fdeec39127d552f322285/unix
>---------------------------------------------------------------
commit a5aa36d7a86ccfea758fdeec39127d552f322285
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Fri Nov 8 15:48:18 2013 +0100
`M-x untabify` & `M-x delete-trailing-whitespace`
...on recently touched files
Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>
>---------------------------------------------------------------
a5aa36d7a86ccfea758fdeec39127d552f322285
System/Posix/Process/ByteString.hsc | 23 +++++++++++------------
System/Posix/Process/Common.hsc | 30 +++++++++++++++---------------
System/Posix/Signals.hsc | 19 +++++++++----------
3 files changed, 35 insertions(+), 37 deletions(-)
diff --git a/System/Posix/Process/ByteString.hsc b/System/Posix/Process/ByteString.hsc
index 4c6840a..294970e 100644
--- a/System/Posix/Process/ByteString.hsc
+++ b/System/Posix/Process/ByteString.hsc
@@ -100,7 +100,7 @@ import System.Posix.ByteString.FilePath
-- the argument list passed to 'executeFile' therefore
-- begins with @arg[1]@.
executeFile :: RawFilePath -- ^ Command
- -> Bool -- ^ Search PATH?
+ -> Bool -- ^ Search PATH?
-> [ByteString] -- ^ Arguments
-> Maybe [(ByteString, ByteString)] -- ^ Environment
-> IO a
@@ -108,10 +108,10 @@ executeFile path search args Nothing = do
withFilePath path $ \s ->
withMany withFilePath (path:args) $ \cstrs ->
withArray0 nullPtr cstrs $ \arr -> do
- pPrPr_disableITimers
- if search
- then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr)
- else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr)
+ pPrPr_disableITimers
+ if search
+ then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr)
+ else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr)
return undefined -- never reached
executeFile path search args (Just env) = do
@@ -121,12 +121,12 @@ executeFile path search args (Just env) = do
let env' = map (\ (name, val) -> name `BC.append` ('=' `BC.cons` val)) env in
withMany withFilePath env' $ \cenv ->
withArray0 nullPtr cenv $ \env_arr -> do
- pPrPr_disableITimers
- if search
- then throwErrnoPathIfMinus1_ "executeFile" path
- (c_execvpe s arg_arr env_arr)
- else throwErrnoPathIfMinus1_ "executeFile" path
- (c_execve s arg_arr env_arr)
+ pPrPr_disableITimers
+ if search
+ then throwErrnoPathIfMinus1_ "executeFile" path
+ (c_execvpe s arg_arr env_arr)
+ else throwErrnoPathIfMinus1_ "executeFile" path
+ (c_execve s arg_arr env_arr)
return undefined -- never reached
foreign import ccall unsafe "execvp"
@@ -137,4 +137,3 @@ foreign import ccall unsafe "execv"
foreign import ccall unsafe "execve"
c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
-
diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc
index e8fd415..66e0d20 100644
--- a/System/Posix/Process/Common.hsc
+++ b/System/Posix/Process/Common.hsc
@@ -83,7 +83,7 @@ import Control.Monad
#ifdef __GLASGOW_HASKELL__
import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess
-import GHC.TopHandler ( runIO )
+import GHC.TopHandler ( runIO )
import GHC.IO ( unsafeUnmask, uninterruptibleMask_ )
#endif
@@ -188,11 +188,11 @@ foreign import ccall unsafe "setsid"
data ProcessTimes
= ProcessTimes { elapsedTime :: ClockTick
- , userTime :: ClockTick
- , systemTime :: ClockTick
- , childUserTime :: ClockTick
- , childSystemTime :: ClockTick
- }
+ , userTime :: ClockTick
+ , systemTime :: ClockTick
+ , childUserTime :: ClockTick
+ , childSystemTime :: ClockTick
+ }
-- | 'getProcessTimes' calls @times@ to obtain time-accounting
-- information for the current process and its children.
@@ -205,11 +205,11 @@ getProcessTimes = do
cut <- (#peek struct tms, tms_cutime) p_tms
cst <- (#peek struct tms, tms_cstime) p_tms
return (ProcessTimes{ elapsedTime = elapsed,
- userTime = ut,
- systemTime = st,
- childUserTime = cut,
- childSystemTime = cst
- })
+ userTime = ut,
+ systemTime = st,
+ childUserTime = cut,
+ childSystemTime = cst
+ })
type CTms = ()
@@ -329,11 +329,11 @@ getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus block stopped pid =
alloca $ \wstatp -> do
pid' <- throwErrnoIfMinus1Retry "getProcessStatus"
- (c_waitpid pid wstatp (waitOptions block stopped))
+ (c_waitpid pid wstatp (waitOptions block stopped))
case pid' of
0 -> return Nothing
_ -> do ps <- readWaitStatus wstatp
- return (Just ps)
+ return (Just ps)
-- safe/interruptible, because this call might block
foreign import ccall interruptible "waitpid"
@@ -356,11 +356,11 @@ getGroupProcessStatus :: Bool
getGroupProcessStatus block stopped pgid =
alloca $ \wstatp -> do
pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus"
- (c_waitpid (-pgid) wstatp (waitOptions block stopped))
+ (c_waitpid (-pgid) wstatp (waitOptions block stopped))
case pid of
0 -> return Nothing
_ -> do ps <- readWaitStatus wstatp
- return (Just (pid, ps))
+ return (Just (pid, ps))
-- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning
-- @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any
diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index 4b5321e..d4c6d51 100644
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -315,7 +315,7 @@ type Signal = CInt
-- | The actions to perform when a signal is received.
data Handler = Default
| Ignore
- -- not yet: | Hold
+ -- not yet: | Hold
| Catch (IO ())
| CatchOnce (IO ())
| CatchInfo (SignalInfo -> IO ()) -- ^ /Since: 2.7.0.0/
@@ -354,8 +354,8 @@ data SignalSpecificInfo
-- signal handler for @int@ is returned
installHandler :: Signal
-> Handler
- -> Maybe SignalSet -- ^ other signals to block
- -> IO Handler -- ^ old handler
+ -> Maybe SignalSet -- ^ other signals to block
+ -> IO Handler -- ^ old handler
#ifdef __PARALLEL_HASKELL__
installHandler =
@@ -417,10 +417,10 @@ installHandler sig handler _maybe_mask = do
foreign import ccall unsafe
stg_sig_install
- :: CInt -- sig no.
- -> CInt -- action code (STG_SIG_HAN etc.)
- -> Ptr CSigset -- (in, out) blocked
- -> IO CInt -- (ret) old action code
+ :: CInt -- sig no.
+ -> CInt -- action code (STG_SIG_HAN etc.)
+ -> Ptr CSigset -- (in, out) blocked
+ -> IO CInt -- (ret) old action code
getinfo :: (SignalInfo -> IO ()) -> ForeignPtr Word8 -> IO ()
getinfo handler fp_info = do
@@ -593,8 +593,8 @@ getPendingSignals = do
awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal maybe_sigset = do
fp <- case maybe_sigset of
- Nothing -> do SignalSet fp <- getSignalMask; return fp
- Just (SignalSet fp) -> return fp
+ Nothing -> do SignalSet fp <- getSignalMask; return fp
+ Just (SignalSet fp) -> return fp
withForeignPtr fp $ \p -> do
_ <- c_sigsuspend p
return ()
@@ -640,4 +640,3 @@ foreign import capi unsafe "signal.h sigismember"
foreign import ccall unsafe "sigpending"
c_sigpending :: Ptr CSigset -> IO CInt
-
More information about the ghc-commits
mailing list