Commit 3c759ced authored by Alp Mestanogullari's avatar Alp Mestanogullari Committed by Marge Bot

Hadrian: add a --test-accept/-a flag, to mimic 'make accept'

When -a or --test-accept is passed, and if one runs the 'test' target, then
any test failing because of mismatching output and which is not expected to
fail will have its expected output adjusted by the test driver, effectively
considering the new output correct from now on.

When this flag is passed, hadrian's 'test' target becomes sensitive to the
PLATFORM and OS environment variable, just like the Make build system:
- when the PLATFORM env var is set to "YES", when accepting a result, accept it
  for the current platform;
- when the OS env var is set to "YES", when accepting a result, accept it
  for all wordsizes of the current operating system.

This can all be combined with `--only="..."` and `TEST="..." to only accept
the new output of a subset of tests.
parent 885d2e04
...@@ -56,7 +56,8 @@ data TestArgs = TestArgs ...@@ -56,7 +56,8 @@ data TestArgs = TestArgs
, testSpeed :: TestSpeed , testSpeed :: TestSpeed
, testSummary :: Maybe FilePath , testSummary :: Maybe FilePath
, testVerbosity :: Maybe String , testVerbosity :: Maybe String
, testWays :: [String] } , testWays :: [String]
, testAccept :: Bool}
deriving (Eq, Show) deriving (Eq, Show)
-- | Default value for `TestArgs`. -- | Default value for `TestArgs`.
...@@ -73,7 +74,8 @@ defaultTestArgs = TestArgs ...@@ -73,7 +74,8 @@ defaultTestArgs = TestArgs
, testSpeed = TestNormal , testSpeed = TestNormal
, testSummary = Nothing , testSummary = Nothing
, testVerbosity = Nothing , testVerbosity = Nothing
, testWays = [] } , testWays = []
, testAccept = False }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Right $ \flags -> flags { configure = True } readConfigure = Right $ \flags -> flags { configure = True }
...@@ -124,6 +126,9 @@ readProgressInfo ms = ...@@ -124,6 +126,9 @@ readProgressInfo ms =
readTestKeepFiles :: Either String (CommandLineArgs -> CommandLineArgs) readTestKeepFiles :: Either String (CommandLineArgs -> CommandLineArgs)
readTestKeepFiles = Right $ \flags -> flags { testArgs = (testArgs flags) { testKeepFiles = True } } readTestKeepFiles = Right $ \flags -> flags { testArgs = (testArgs flags) { testKeepFiles = True } }
readTestAccept :: Either String (CommandLineArgs -> CommandLineArgs)
readTestAccept = Right $ \flags -> flags { testArgs = (testArgs flags) { testAccept = True } }
readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler readTestCompiler compiler = maybe (Left "Cannot parse compiler") (Right . set) compiler
where where
...@@ -245,7 +250,8 @@ optDescrs = ...@@ -245,7 +250,8 @@ optDescrs =
, Option [] ["test-verbose"] (OptArg readTestVerbose "TEST_VERBOSE") , Option [] ["test-verbose"] (OptArg readTestVerbose "TEST_VERBOSE")
"A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output." "A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output."
, Option [] ["test-way"] (OptArg readTestWay "TEST_WAY") , Option [] ["test-way"] (OptArg readTestWay "TEST_WAY")
"only run these ways" ] "only run these ways"
, Option ['a'] ["test-accept"] (NoArg readTestAccept) "Accept new output of tests" ]
-- | A type-indexed map containing Hadrian command line arguments to be passed -- | A type-indexed map containing Hadrian command line arguments to be passed
-- to Shake via 'shakeExtra'. -- to Shake via 'shakeExtra'.
......
...@@ -71,6 +71,11 @@ runTestBuilderArgs = builder RunTest ? do ...@@ -71,6 +71,11 @@ runTestBuilderArgs = builder RunTest ? do
debugged <- read <$> getTestSetting TestGhcDebugged debugged <- read <$> getTestSetting TestGhcDebugged
keepFiles <- expr (testKeepFiles <$> userSetting defaultTestArgs) keepFiles <- expr (testKeepFiles <$> userSetting defaultTestArgs)
accept <- expr (testAccept <$> userSetting defaultTestArgs)
(acceptPlatform, acceptOS) <- expr . liftIO $
(,) <$> (maybe False (=="YES") <$> lookupEnv "PLATFORM")
<*> (maybe False (=="YES") <$> lookupEnv "OS")
windows <- expr windowsHost windows <- expr windowsHost
darwin <- expr osxHost darwin <- expr osxHost
threads <- shakeThreads <$> expr getShakeOptions threads <- shakeThreads <$> expr getShakeOptions
...@@ -95,6 +100,9 @@ runTestBuilderArgs = builder RunTest ? do ...@@ -95,6 +100,9 @@ runTestBuilderArgs = builder RunTest ? do
, arg "-e", arg $ "darwin=" ++ show darwin , arg "-e", arg $ "darwin=" ++ show darwin
, arg "-e", arg $ "config.local=False" , arg "-e", arg $ "config.local=False"
, arg "-e", arg $ "config.cleanup=" ++ show (not keepFiles) , arg "-e", arg $ "config.cleanup=" ++ show (not keepFiles)
, arg "-e", arg $ "config.accept=" ++ show accept
, arg "-e", arg $ "config.accept_platform=" ++ show acceptPlatform
, arg "-e", arg $ "config.accept_os=" ++ show acceptOS
, arg "-e", arg $ "config.exeext=" ++ quote exe , arg "-e", arg $ "config.exeext=" ++ quote exe
, arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged) , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
, arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged) , arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged)
......
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