From 6956f533fe8d0f762b061d80a49cae8bc860b881 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 30 Oct 2018 01:08:29 -0400 Subject: [PATCH] better method of waiting for new mtime This will even work on eg FAT with its 1-2 second mtime granularity. And without slowing down everything else. --- Test/Framework.hs | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/Test/Framework.hs b/Test/Framework.hs index db6a5117a8..c7a43034e0 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -504,14 +504,26 @@ content f | "import" `isPrefixOf` f = "imported content" | otherwise = "unknown file " ++ f +-- Writes new content to a file, and makes sure that it has a different +-- mtime than it did before writecontent :: FilePath -> String -> IO () -writecontent f c = do - -- Delay 1/10th of a second, because filesystem's - -- mtime resolution may not be very high, and we want to make sure - -- that git etc notices the file has been modified even when - -- multiple modifications happen close together. - threadDelay 100000 - writeFile f c +writecontent f c = go (10000000 :: Integer) + where + go ticsleft = do + oldmtime <- catchMaybeIO $ getModificationTime f + writeFile f c + newmtime <- getModificationTime f + if Just newmtime == oldmtime + then do + threadDelay 100000 + let ticsleft' = ticsleft - 100000 + if ticsleft' > 0 + then go ticsleft' + else do + hPutStrLn stderr "file mtimes do not seem to be changing (tried for 10 seconds)" + hFlush stderr + return () + else return () changecontent :: FilePath -> IO () changecontent f = writecontent f $ changedcontent f