filelock 0.1.1.4 → 0.1.1.5

raw patch · 4 files changed

+53/−5 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

System/FileLock.hs +4/−0
System/FileLock/Internal/Flock.hsc +12/−3
filelock.cabal +13/−2
tests/interrupt.hs +24/−0

System/FileLock.hs view

@@ -20,6 +20,10 @@ -- -- Note on the implementation: currently the module uses flock(2) on non-Windows -- platforms, and LockFileEx on Windows.+--+-- On non-Windows platforms, @InterruptibleFFI@ is used in the implementation to+-- ensures that blocking lock calls can be correctly interrupted by async+-- exceptions (e.g. functions like `timeout`).  This has been tested on Linux. module System.FileLock   ( FileLock   , SharedExclusive(..)

System/FileLock/Internal/Flock.hsc view

@@ -1,3 +1,5 @@+{-# LANGUAGE InterruptibleFFI #-}+ module System.FileLock.Internal.Flock #ifndef USE_FLOCK   () where@@ -7,6 +9,7 @@ #include <sys/file.h>  import Control.Applicative+import Control.Concurrent (yield) import qualified Control.Exception as E import Data.Bits import Foreign.C.Error@@ -64,8 +67,12 @@       case () of         _ | errno == eWOULDBLOCK             -> return False -- already taken-          | errno == eINTR-            -> flock (Fd fd) exclusive block+          | errno == eINTR -> do+              -- If InterruptibleFFI interrupted the syscall with EINTR,+              -- we need to give the accompanying Haskell exception a chance to bubble.+              -- See also https://gitlab.haskell.org/ghc/ghc/issues/8684#note_142404.+              E.interruptible yield+              flock (Fd fd) exclusive block           | otherwise -> throwErrno "flock"   where     modeOp = case exclusive of@@ -75,7 +82,9 @@       True -> 0       False -> #{const LOCK_NB} -foreign import ccall "flock"+-- `interruptible` so that async exceptions like `timeout` can stop it+-- when used in blocking mode (without `LOCK_NB`).+foreign import ccall interruptible "flock"   c_flock :: CInt -> CInt -> IO CInt  #endif /* USE_FLOCK */

filelock.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                filelock-version:             0.1.1.4+version:             0.1.1.5 synopsis:            Portable interface to file locking (flock / LockFileEx) description:         This package provides an interface to Windows and Unix                      file locking functionalities.@@ -17,13 +17,14 @@ -- extra-source-files:   cabal-version:       >=1.10 extra-source-files:  tests/lock.log.expected+tested-with:         GHC ==8.4.2 || ==8.6.5 || ==8.8.3  library   exposed-modules:     System.FileLock   other-modules:       System.FileLock.Internal.Flock                        System.FileLock.Internal.LockFileEx   -- other-extensions:    -  build-depends:       base >=4.5.1.0 && <5+  build-depends:       base >=4.9.0.0 && <5   -- hs-source-dirs:         default-language:    Haskell2010 @@ -42,6 +43,16 @@   build-depends:      filelock, process >= 1.2.1.0, async, base   ghc-options:        -threaded   default-language:   Haskell2010++test-suite interrupt+  type:               exitcode-stdio-1.0+  hs-source-dirs:     tests+  main-is:            interrupt.hs+  build-depends:      filelock, process >= 1.2.1.0, async, base+  ghc-options:        -threaded+  default-language:   Haskell2010+  if os(windows)+    buildable:        False  source-repository head   type: git

+ tests/interrupt.hs view

@@ -0,0 +1,24 @@+import Control.Concurrent+import Control.Exception+import Control.Monad+import System.FileLock+import System.Exit+import System.Timeout++main :: IO ()+main = withFileLock lockFilePath Exclusive $ \_ -> do+  mvar <- newMVar Nothing+  _ <- forkIO $ do+    -- The attempt to lock the file again should block, but it should be+    -- interrupted by the timeout, returning Nothing.+    --+    -- Also masking shouldn't change interruptibility.+    r <- timeout 1000000 $ mask $ \_ -> lockFile lockFilePath Exclusive+    _ <- swapMVar mvar (Just r)+    return ()+  threadDelay 2000000+  res <- readMVar mvar+  when (res /= Just Nothing) $+    die $ "unexpected result: " ++ show (fmap (const ()) <$> res)+  where+    lockFilePath = "interrupt_test.lock"