diff --git a/test/FSNotify/Test/EventTests.hs b/test/FSNotify/Test/EventTests.hs index 4fd9f91..cbb3789 100644 --- a/test/FSNotify/Test/EventTests.hs +++ b/test/FSNotify/Test/EventTests.hs @@ -25,7 +25,7 @@ import UnliftIO.Directory eventTests :: ( - MonadUnliftIO m, MonadThrow m, HasParallelSemaphore' context + MonadUnliftIO m, MonadThrow m ) => ThreadingMode -> SpecFree context m () eventTests threadingMode = describe "Tests" $ parallel $ do let pollOptions = if isBSD then [True] else [False, True] @@ -37,7 +37,7 @@ eventTests threadingMode = describe "Tests" $ parallel $ do eventTests' timeInterval threadingMode poll recursive nested eventTests' :: ( - MonadUnliftIO m, MonadThrow m, HasParallelSemaphore' context + MonadUnliftIO m, MonadThrow m ) => Int -> ThreadingMode -> Bool -> Bool -> Bool -> SpecFree context m () eventTests' timeInterval threadingMode poll recursive nested = do -- withParallelSemaphore $ let itWithFolder name action = introduceTestFolder timeInterval threadingMode poll recursive nested $ it name action diff --git a/test/FSNotify/Test/Util.hs b/test/FSNotify/Test/Util.hs index 279ccf8..15fa91c 100644 --- a/test/FSNotify/Test/Util.hs +++ b/test/FSNotify/Test/Util.hs @@ -17,7 +17,6 @@ import Control.Retry import Data.String.Interpolate import System.FSNotify import System.FilePath -import System.PosixCompat.Files (touchFile) import System.Random as R import Test.Sandwich import UnliftIO hiding (poll, Handler) @@ -31,12 +30,15 @@ import Data.Monoid #ifdef mingw32_HOST_OS import Data.Bits import System.Win32.File (getFileAttributes, setFileAttributes, fILE_ATTRIBUTE_TEMPORARY) + -- Perturb the file's attributes, to check that a modification event is emitted changeFileAttributes :: FilePath -> IO () changeFileAttributes file = do attrs <- getFileAttributes file setFileAttributes file (attrs `xor` fILE_ATTRIBUTE_TEMPORARY) #else +import System.PosixCompat.Files (touchFile) + changeFileAttributes :: FilePath -> IO () changeFileAttributes = touchFile #endif @@ -150,14 +152,14 @@ withRandomTempDirectory action = do randomID <- liftIO $ replicateM 10 $ R.randomRIO ('a', 'z') withSystemTempDirectory ("test." <> randomID) action -withParallelSemaphore :: forall context m. ( - MonadUnliftIO m, HasLabel context "parallelSemaphore" QSem - ) => SpecFree context m () -> SpecFree context m () -withParallelSemaphore = around' (defaultNodeOptions { nodeOptionsRecordTime = False, nodeOptionsVisibilityThreshold = 125 }) "claim semaphore" $ \action -> do - s <- getContext parallelSemaphore' - bracket_ (liftIO $ waitQSem s) (liftIO $ signalQSem s) (void action) +-- withParallelSemaphore :: forall context m. ( +-- MonadUnliftIO m, HasLabel context "parallelSemaphore" QSem +-- ) => SpecFree context m () -> SpecFree context m () +-- withParallelSemaphore = around' (defaultNodeOptions { nodeOptionsRecordTime = False, nodeOptionsVisibilityThreshold = 125 }) "claim semaphore" $ \action -> do +-- s <- getContext parallelSemaphore' +-- bracket_ (liftIO $ waitQSem s) (liftIO $ signalQSem s) (void action) -parallelSemaphore' :: Label "parallelSemaphore" QSem -parallelSemaphore' = Label +-- parallelSemaphore' :: Label "parallelSemaphore" QSem +-- parallelSemaphore' = Label -type HasParallelSemaphore' context = HasLabel context "parallelSemaphore" QSem +-- type HasParallelSemaphore' context = HasLabel context "parallelSemaphore" QSem