Commit 70cc6971 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Calibrate file modification time and use it in recompilation tests.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent b11daf73
......@@ -405,6 +405,7 @@ test-suite package-tests
tasty,
tasty-hunit,
transformers,
time,
Cabal,
process,
directory,
......
......@@ -174,8 +174,8 @@ getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.
-- | Based on code written by Neil Mitchell for Shake. See
-- 'sleepFileTimeCalibrate' in 'Test.Type'. Returns a pair
-- of the maximum delay seen, and the recommended delay to
-- use before testing for file modification change.
-- 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)
......
......@@ -21,6 +21,7 @@ import Distribution.Simple.Utils (cabalVersion)
import Distribution.Text (display)
import Distribution.Verbosity (normal, flagToVerbosity, lessVerbose)
import Distribution.ReadE (readEOrFail)
import Distribution.Compat.Time (calibrateMtimeChangeDelay)
import Control.Exception
import Data.Proxy ( Proxy(..) )
......@@ -197,6 +198,9 @@ main = do
-- the install directories, so we don't clobber anything in the
-- default install paths. VERY IMPORTANT.
-- Figure out how long we need to delay for recompilation tests
(mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
let suite = SuiteConfig
{ cabalDistPref = dist_dir
, bootProgramsConfig = boot_programs
......@@ -205,12 +209,18 @@ main = do
, withGhcDBStack = with_ghc_db_stack
, suiteVerbosity = verbosity
, absoluteCWD = cabal_dir
, mtimeChangeDelay = mtimeChange'
}
let toMillis :: Int -> Double
toMillis x = fromIntegral x / 1000.0
putStrLn $ "Cabal test suite - testing cabal version "
++ display cabalVersion
putStrLn $ "Cabal build directory: " ++ dist_dir
putStrLn $ "Cabal source directory: " ++ cabal_dir
putStrLn $ "File modtime calibration: " ++ show (toMillis mtimeChange')
++ " (maximum observed: " ++ show (toMillis mtimeChange) ++ ")"
-- TODO: it might be useful to factor this out so that ./Setup
-- configure dumps this file, so we can read it without in a version
-- stable way.
......
......@@ -56,6 +56,7 @@ module PackageTests.PackageTester
, assertOutputDoesNotContain
, assertFindInFile
, concatOutput
, ghcFileModDelay
-- * Test trees
, TestTreeM
......@@ -122,6 +123,7 @@ import System.FilePath
import System.IO
import System.IO.Error (isDoesNotExistError)
import System.Process (runProcess, waitForProcess, showCommandForUser)
import Control.Concurrent (threadDelay)
import Test.Tasty (TestTree, askOption, testGroup)
-- | Our test monad maintains an environment recording the global test
......@@ -191,6 +193,9 @@ data SuiteConfig = SuiteConfig
, suiteVerbosity :: Verbosity
-- | The absolute current working directory
, absoluteCWD :: FilePath
-- | How long we should 'threadDelay' to make sure the file timestamp is
-- updated correctly for recompilation tests.
, mtimeChangeDelay :: Int
}
getProgram :: ProgramDb -> Program -> ConfiguredProgram
......@@ -719,6 +724,23 @@ assertFindInFile needle path =
concatOutput :: String -> String
concatOutput = unwords . lines . filter ((/=) '\r')
-- | Delay a sufficient period of time to permit file timestamp
-- to be updated.
ghcFileModDelay :: TestM ()
ghcFileModDelay = do
(suite, _) <- ask
-- For old versions of GHC, we only had second-level precision,
-- so we need to sleep a full second. Newer versions use
-- millisecond level precision, so we only have to wait
-- the granularity of the underlying filesystem.
-- TODO: cite commit when GHC got better precision; this
-- version bound was empirically generated.
let delay | withGhcVersion suite < Version [7,7] []
= 1000000 -- 1s
| otherwise
= mtimeChangeDelay suite
liftIO $ threadDelay delay
------------------------------------------------------------------------
-- * Test trees
......
......@@ -352,6 +352,7 @@ tests config = do
cabal "configure" []
cabal "build" []
runExe' "T3294" [] >>= assertOutputContains "aaa"
ghcFileModDelay
liftIO $ writeFile (pkg_dir </> "Main.hs") "main = putStrLn \"bbb\""
cabal "build" []
runExe' "T3294" [] >>= assertOutputContains "bbb"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment