Remove calibrateMtimeChangeDelay, it's irrelevant for modern file systems

Cabal-tests/tests/UnitTests.hs

@@ -7,10 +7,6 @@ import Test.Tasty.Options
 
 import Data.Proxy
 
-import Distribution.Simple.Utils
-import Distribution.Verbosity
-import Distribution.Compat.Time
-
 import qualified UnitTests.Distribution.Compat.Time
 import qualified UnitTests.Distribution.Compat.Graph
 import qualified UnitTests.Distribution.PackageDescription.Check
@@ -33,14 +29,10 @@ import qualified UnitTests.Distribution.Described
 import qualified UnitTests.Distribution.CabalSpecVersion
 import qualified UnitTests.Distribution.Types.GenericPackageDescription
 
-tests :: Int -> TestTree
-tests mtimeChangeCalibrated =
-  askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) ->
+tests :: TestTree
+tests =
+  askOption $ \(OptionMtimeChangeDelay mtimeChange) ->
   askOption $ \(GhcPath ghcPath) ->
-  let mtimeChange = if mtimeChangeProvided /= 0
-                    then mtimeChangeProvided
-                    else mtimeChangeCalibrated
-  in
   testGroup "Unit Tests"
     [ testGroup "Distribution.Compat.Time"
         (UnitTests.Distribution.Compat.Time.tests mtimeChange)
@@ -90,7 +82,8 @@ extraOptions =
 newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int
 
 instance IsOption OptionMtimeChangeDelay where
-  defaultValue   = OptionMtimeChangeDelay 0
+  defaultValue = OptionMtimeChangeDelay 10000
+  showDefaultValue (OptionMtimeChangeDelay v) = Just (show v)
   parseValue     = fmap OptionMtimeChangeDelay . safeRead
   optionName     = return "mtime-change-delay"
   optionHelp     = return $ "How long to wait before attempting to detect"
@@ -105,15 +98,7 @@ instance IsOption GhcPath where
   parseValue   = Just . GhcPath
 
 main :: IO ()
-main = do
-  (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
-  let toMillis :: Int -> Double
-      toMillis x = fromIntegral x / 1000.0
-  notice (mkVerbosity defaultVerbosityHandles normal) $ "File modification time resolution calibration completed, "
-    ++ "maximum delay observed: "
-    ++ (show . toMillis $ mtimeChange ) ++ " ms. "
-    ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange')
-    ++ " for test runs."
+main =
   defaultMainWithIngredients
-         (includingOptions extraOptions : defaultIngredients)
-         (tests mtimeChange')
+    (includingOptions extraOptions : defaultIngredients)
+    tests

Cabal/src/Distribution/Compat/Time.hs

@@ -12,7 +12,6 @@ module Distribution.Compat.Time
   , getFileAge
   , getCurTime
   , posixSecondsToModTime
-  , calibrateMtimeChangeDelay
   )
 where
 
@@ -21,11 +20,6 @@ import Prelude ()
 
 import System.Directory (getModificationTime)
 
-import Distribution.Simple.Utils (withTempDirectoryCwd)
-import Distribution.Utils.Path (getSymbolicPath, sameDirectory)
-
-import System.FilePath
-
 import Data.Time (diffUTCTime, getCurrentTime)
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixDayLength)
 
@@ -147,32 +141,3 @@ getFileAge file = do
 -- | Return the current time as 'ModTime'.
 getCurTime :: IO ModTime
 getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.
-
--- | Based on code written by Neil Mitchell for Shake. See
--- 'sleepFileTimeCalibrate' in 'Test.Type'.  Returns a pair
--- of microsecond values: first, the maximum delay seen, and the
--- recommended delay to use before testing for file modification change.
--- The returned delay is never smaller
--- than 10 ms, but never larger than 1 second.
-calibrateMtimeChangeDelay :: IO (Int, Int)
-calibrateMtimeChangeDelay = do
-  withTempDirectoryCwd Nothing sameDirectory "calibration-" $ \dir -> do
-    let fileName = getSymbolicPath dir </> "probe"
-    mtimes <- for [1 .. 25] $ \(i :: Int) -> time $ do
-      writeFile fileName $ show i
-      t0 <- getModTime fileName
-      let spin j = do
-            writeFile fileName $ show (i, j)
-            t1 <- getModTime fileName
-            unless (t0 < t1) (spin $ j + 1)
-      spin (0 :: Int)
-    let mtimeChange = maximum mtimes
-        mtimeChange' = min 1000000 $ (max 10000 mtimeChange) * 2
-    return (mtimeChange, mtimeChange')
-  where
-    time :: IO () -> IO Int
-    time act = do
-      t0 <- getCurrentTime
-      act
-      t1 <- getCurrentTime
-      return . ceiling $! (t1 `diffUTCTime` t0) * 1e6 -- microseconds

cabal-install/tests/LongTests.hs

@@ -2,48 +2,29 @@ module Main (main) where
 
 import Test.Tasty
 
-import Distribution.Compat.Time
-import Distribution.Simple.Utils
-import Distribution.Verbosity
-
 import qualified UnitTests.Distribution.Client.Described
 import qualified UnitTests.Distribution.Client.FileMonitor
 import qualified UnitTests.Distribution.Client.VCS
 import qualified UnitTests.Distribution.Solver.Modular.QuickCheck
 import UnitTests.Options
 
 main :: IO ()
-main = do
-  (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
-  let toMillis :: Int -> Double
-      toMillis x = fromIntegral x / 1000.0
-  notice (mkVerbosity defaultVerbosityHandles normal) $
-    "File modification time resolution calibration completed, "
-      ++ "maximum delay observed: "
-      ++ (show . toMillis $ mtimeChange)
-      ++ " ms. "
-      ++ "Will be using delay of "
-      ++ (show . toMillis $ mtimeChange')
-      ++ " for test runs."
+main =
   defaultMainWithIngredients
     (includingOptions extraOptions : defaultIngredients)
-    (tests mtimeChange')
+    tests
 
-tests :: Int -> TestTree
-tests mtimeChangeCalibrated =
-  askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) ->
-    let mtimeChange =
-          if mtimeChangeProvided /= 0
-            then mtimeChangeProvided
-            else mtimeChangeCalibrated
-     in testGroup
-          "Long-running tests"
-          [ testGroup
-              "Solver QuickCheck"
-              UnitTests.Distribution.Solver.Modular.QuickCheck.tests
-          , testGroup "UnitTests.Distribution.Client.VCS" $
-              UnitTests.Distribution.Client.VCS.tests mtimeChange
-          , testGroup "UnitTests.Distribution.Client.FileMonitor" $
-              UnitTests.Distribution.Client.FileMonitor.tests mtimeChange
-          , UnitTests.Distribution.Client.Described.tests
-          ]
+tests :: TestTree
+tests =
+  askOption $ \(OptionMtimeChangeDelay mtimeChange) ->
+    testGroup
+      "Long-running tests"
+      [ testGroup
+          "Solver QuickCheck"
+          UnitTests.Distribution.Solver.Modular.QuickCheck.tests
+      , testGroup "UnitTests.Distribution.Client.VCS" $
+          UnitTests.Distribution.Client.VCS.tests mtimeChange
+      , testGroup "UnitTests.Distribution.Client.FileMonitor" $
+          UnitTests.Distribution.Client.FileMonitor.tests mtimeChange
+      , UnitTests.Distribution.Client.Described.tests
+      ]

cabal-install/tests/UnitTests/Options.hs

@@ -33,7 +33,8 @@ instance IsOption OptionShowSolverLog where
 newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int
 
 instance IsOption OptionMtimeChangeDelay where
-  defaultValue = OptionMtimeChangeDelay 0
+  defaultValue = OptionMtimeChangeDelay 10000
+  showDefaultValue (OptionMtimeChangeDelay v) = Just (show v)
   parseValue = fmap OptionMtimeChangeDelay . safeRead
   optionName = return "mtime-change-delay"
   optionHelp =

cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.test.hs

@@ -1,5 +1,5 @@
 import Test.Cabal.Prelude
-main = cabalTest $ withDelay $ do
+main = cabalTest $ do
         copySourceFileTo "q/q-broken.cabal.in" "q/q.cabal"
         fails $ cabal "v2-build" ["q"]
         delay

cabal-testsuite/PackageTests/Regression/T3294/setup.test.hs

@@ -3,7 +3,6 @@ import Control.Monad.IO.Class
 -- Test that executable recompilation works
 -- https://github.com/haskell/setup/issues/3294
 main = setupAndCabalTest $ do
-    withDelay $ do
         writeSourceFile "Main.hs" "main = putStrLn \"aaa\""
         setup "configure" []
         setup "build" []

cabal-testsuite/PackageTests/Regression/T4202/cabal.test.hs

@@ -1,5 +1,5 @@
 import Test.Cabal.Prelude
-main = cabalTest $ withDelay $ do
+main = cabalTest $ do
         writeSourceFile ("p/P.hs") "module P where\np = \"AAA\""
         cabal "v2-build" ["p","q"]
         delay

cabal-testsuite/PackageTests/Regression/T5782Diamond/cabal.test.hs

@@ -21,8 +21,7 @@
 
 import Test.Cabal.Prelude
 main =
-  cabalTest $ withShorterPathForNewBuildStore .
-    withDelay $ do
+  cabalTest $ withShorterPathForNewBuildStore $ do
         storeDir <- testStoreDir <$> getTestEnv
         writeSourceFile "issue5782/src/Module.hs" "module Module where\nf = \"AAA\""
         recordMode DoNotRecord $

cabal-testsuite/src/Test/Cabal/Monad.hs

@@ -439,7 +439,7 @@ runTestM mode m =
                 , testCompilerPath = programPath configuredGhcProg
                 , testPackageDBStack = db_stack
                 , testVerbosityFlags = verbosityFlags verbosity
-                , testMtimeChangeDelay = Nothing
+                , testMtimeChangeDelay = 10000
                 , testScriptEnv = senv
                 , testSetupPath = dist_dir </> "build" </> "setup" </> "setup"
                 , testPackageDbPath = case testArgPackageDb args of [] -> Nothing; xs -> Just xs
@@ -847,10 +847,9 @@ data TestEnv = TestEnv
   -- ^ Package database stack (actually this changes lol)
   , testVerbosityFlags :: VerbosityFlags
   -- ^ How verbose to be
-  , testMtimeChangeDelay :: Maybe Int
+  , testMtimeChangeDelay :: Int
   -- ^ How long we should 'threadDelay' to make sure the file timestamp is
-  -- updated correctly for recompilation tests.  Nothing if we haven't
-  -- calibrated yet.
+  -- updated correctly for recompilation tests.
   , testScriptEnv :: ScriptEnv
   -- ^ Script environment for runghc
   , testSetupPath :: FilePath

cabal-testsuite/src/Test/Cabal/Prelude.hs

@@ -28,7 +28,6 @@ import Test.Cabal.Run
 import Test.Cabal.Script
 import Test.Cabal.TestCode
 
-import Distribution.Compat.Time (calibrateMtimeChangeDelay)
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.Parsec (eitherParsec, simpleParsec)
@@ -1360,22 +1359,7 @@ delay = do
   liftIO . threadDelay $
     if is_old_ghc
       then 1000000
-      else
-        fromMaybe
-          (error "Delay must be enclosed by withDelay")
-          (testMtimeChangeDelay env)
-
--- | Calibrate file modification time delay, if not
--- already determined.
-withDelay :: TestM a -> TestM a
-withDelay m = do
-  env <- getTestEnv
-  case testMtimeChangeDelay env of
-    Nothing -> do
-      -- Figure out how long we need to delay for recompilation tests
-      (_, mtimeChange) <- liftIO $ calibrateMtimeChangeDelay
-      withReaderT (\nenv -> nenv{testMtimeChangeDelay = Just mtimeChange}) m
-    Just _ -> m
+      else (testMtimeChangeDelay env)
 
 -- | Create a symlink for the duration of the provided action. If the symlink
 -- already exists, it is deleted.

changelog.d/pr-11496.md

@@ -0,0 +1,7 @@
+---
+synopsis: Remove `Distribution.Compat.Time.calibrateMtimeChangeDelay`
+packages: [Cabal]
+prs: 11496
+---
+
+Remove `calibrateMtimeChangeDelay` from `Distribution.Compat.Time`, it's irrelevant for modern file systems, all of which have submicrosecond precision of file modification times. Inside Cabal this function was used only in the test suite.