mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add DebugLocks build flag

Browse source 
Using the method described in
https://www.fpcomplete.com/blog/2018/05/pinpointing-deadlocks-in-haskell
but my own code to implement it, and with callstacks added.

This work is supported by the NIH-funded NICEMAN (ReproNim TR&D3) project.
This commit is contained in:
Joey Hess 2018-11-19 15:00:24 -04:00
parent 953856df5f
commit 9127fe4821
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 88 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

5
Utility/LockPool/LockHandle.hs
View file

@ -20,6 +20,7 @@ module Utility.LockPool.LockHandle (
import qualified Utility.LockPool.STM as P
import Utility.LockPool.STM (LockFile)
import Utility.DebugLocks
import Control.Concurrent.STM
import Control.Exception
@ -49,8 +50,8 @@ checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile
makeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM P.LockHandle) -> (LockFile -> IO FileLockOps) -> IO LockHandle
makeLockHandle pool file pa fa = bracketOnError setup cleanup go
where
setup = atomically (pa pool file)
cleanup ph = P.releaseLock ph
setup = debugLocks $ atomically (pa pool file)
cleanup ph = debugLocks $ P.releaseLock ph
go ph = mkLockHandle pool file ph =<< fa file
tryMakeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM (Maybe P.LockHandle)) -> (LockFile -> IO (Maybe FileLockOps)) -> IO (Maybe LockHandle)