process 1.6.1.0 → 1.6.2.0
raw patch · 4 files changed
+30/−8 lines, 4 filesdep ~Win32dep ~base
Dependency ranges changed: Win32, base
Files
- System/Process.hs +3/−3
- changelog.md +7/−1
- process.cabal +3/−3
- test/main.hs +17/−1
System/Process.hs view
@@ -77,7 +77,7 @@ import Control.Concurrent import Control.DeepSeq (rnf)-import Control.Exception (SomeException, mask, bracket, try, throwIO)+import Control.Exception (SomeException, mask, allowInterrupt, bracket, try, throwIO) import qualified Control.Exception as C import Control.Monad import Data.Maybe@@ -209,7 +209,7 @@ -- -- e.g. ----- > withCreateProcess (proc cmd args) { ... } $ \_ _ _ ph -> do+-- > withCreateProcess (proc cmd args) { ... } $ \stdin stdout stderr ph -> do -- > ... -- -- @since 1.4.3.0@@ -589,7 +589,7 @@ OpenHandle h -> do e <- alloca $ \pret -> do -- don't hold the MVar while we call c_waitForProcess...- throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret)+ throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret) modifyProcessHandle ph $ \p_' -> case p_' of ClosedHandle e -> return (p_', e)
changelog.md view
@@ -1,6 +1,12 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) -## 1.6.1.1 *July 2017*+## 1.6.2.0 *October 2017*++* Allow async exceptions to be delivered to masked thread calling `waitForProcess`+ [#101](https://github.com/haskell/process/pull/101)+* Update Win32 package version to 2.6.x++## 1.6.1.0 *July 2017* * Expose `CGid`, `GroupID`, and `UserID` from `System.Process.Internals` [#90](https://github.com/haskell/process/issues/90)
process.cabal view
@@ -1,5 +1,5 @@ name: process-version: 1.6.1.0+version: 1.6.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -56,7 +56,7 @@ other-modules: System.Process.Common if os(windows) other-modules: System.Process.Windows- build-depends: Win32 >=2.2 && < 2.6+ build-depends: Win32 >=2.2 && < 2.7 extra-libraries: kernel32 cpp-options: -DWINDOWS else@@ -74,7 +74,7 @@ ghc-options: -Wall - build-depends: base >= 4.4 && < 4.11,+ build-depends: base >= 4.4 && < 4.12, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5, deepseq >= 1.1 && < 1.5
test/main.hs view
@@ -1,5 +1,5 @@ import Control.Exception-import Control.Monad (unless, void)+import Control.Monad (guard, unless, void) import System.Exit import System.IO.Error import System.Directory (getCurrentDirectory, setCurrentDirectory)@@ -81,6 +81,19 @@ unless (e1 == ExitSuccess && e2 == ExitSuccess) $ error "sleep exited with non-zero exit code!" + do+ putStrLn "interrupt masked waitForProcess"+ (_, _, _, p) <- createProcess (proc "sleep" ["1.0"])+ mec <- newEmptyMVar+ tid <- mask_ . forkIO $+ (waitForProcess p >>= putMVar mec . Just)+ `catchThreadKilled` putMVar mec Nothing+ killThread tid+ eec <- takeMVar mec+ case eec of+ Nothing -> return ()+ Just ec -> error $ "waitForProcess not interrupted: sleep exited with " ++ show ec+ putStrLn "Tests passed successfully" withCurrentDirectory :: FilePath -> IO a -> IO a@@ -90,3 +103,6 @@ (setCurrentDirectory new) (setCurrentDirectory orig) inner++catchThreadKilled :: IO a -> IO a -> IO a+catchThreadKilled f g = catchJust (\e -> guard (e == ThreadKilled)) f (\() -> g)