packages feed

lukko-0.1: test/Tests.hs

{-# LANGUAGE CPP #-}
module Main (main) where

import Control.Concurrent       (threadDelay)
import Control.Concurrent.Async (forConcurrently_)
import Control.Exception        (bracket)
import Data.IORef
import System.FilePath          ((</>))
import System.IO
       (Handle, IOMode (ReadWriteMode), hClose, openFile)
import System.IO.Temp           (withSystemTempDirectory)
import Test.Tasty               (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit         (testCase, (@=?))

import Lukko

#ifdef HAS_OFD_LOCKING
import qualified Lukko.OFD as OFD
#endif

#ifdef HAS_FLOCK
import qualified Lukko.FLock as FLock
#endif

main :: IO ()
main = defaultMain $ testGroup "lukko" $
    [ testGroup "Lukko default" $ testSuite fdLock fdUnlock
    | fileLockingSupported
    ]
#ifdef HAS_OFD_LOCKING
    ++ [ testGroup "Lukko.OFD" $ testSuite OFD.fdLock OFD.fdUnlock ]
#endif
#ifdef HAS_FLOCK
    ++ [ testGroup "Lukko.FLock" $ testSuite FLock.fdLock FLock.fdUnlock ]
#endif

testSuite
    :: (FD -> LockMode -> IO ())
    -> (FD -> IO ())
    -> [TestTree]
testSuite implLock implUnlock =
    [ testCase "concurrent threads" $ do
        let n = 10 :: Int
        ref <- newIORef 0

        withSystemTempDirectory "handle-lock-tests" $ \tmpDir -> do
            -- print tmpDir
            forConcurrently_ [1 :: Int .. n] $ \_ ->
                withLock (tmpDir </> "lock") $ do
                    val <- readIORef ref
                    threadDelay 10000 -- 10ms
                    writeIORef ref (succ val)

        val <- readIORef ref
        val @=? n
    ]
  where
    withLock = genWithLock implLock implUnlock

genWithLock
    :: (FD -> LockMode -> IO ())
    -> (FD -> IO ())
    -> FilePath
    -> IO a
    -> IO a
genWithLock implLock implUnlock fp action =
    bracket takeLock releaseLock (const action)
  where
    takeLock = do
        fd <- fdOpen fp
        implLock fd ExclusiveLock
        return fd

    releaseLock :: FD -> IO ()
    releaseLock fd = do
        implUnlock fd
        fdClose fd