Add config file and test speed options to testsuite (#624)

* Added option to specify config file * Added speed setting for validation * Revision
snowleopard · Jun 15, 2018 · 831e1ce · 831e1ce
1 parent 1906828
commit 831e1ce
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 24 deletions.
diff --git a/src/CommandLine.hs b/src/CommandLine.hs
@@ -45,31 +45,33 @@ defaultCommandLineArgs = CommandLineArgs
 
 -- | These arguments are used by the `test` target.
 data TestArgs = TestArgs
-    { testCompiler :: String
-    , testConfigs  :: [String]
-    , testJUnit    :: Maybe FilePath
-    , testOnly     :: Maybe String
-    , testOnlyPerf :: Bool
-    , testSkipPerf :: Bool
-    , testSpeed    :: TestSpeed
-    , testSummary  :: Maybe FilePath
-    , testVerbosity:: Maybe String
-    , testWays     :: [String] }
+    { testCompiler   :: String
+    , testConfigFile :: String
+    , testConfigs    :: [String]
+    , testJUnit      :: Maybe FilePath
+    , testOnly       :: Maybe String
+    , testOnlyPerf   :: Bool
+    , testSkipPerf   :: Bool
+    , testSpeed      :: TestSpeed
+    , testSummary    :: Maybe FilePath
+    , testVerbosity  :: Maybe String
+    , testWays       :: [String] }
     deriving (Eq, Show)
 
 -- | Default value for `TestArgs`.
 defaultTestArgs :: TestArgs
 defaultTestArgs = TestArgs
-    { testCompiler = "stage2"
-    , testConfigs  = []
-    , testJUnit    = Nothing
-    , testOnly     = Nothing
-    , testOnlyPerf = False
-    , testSkipPerf = False
-    , testSpeed    = Average
-    , testSummary  = Nothing
-    , testVerbosity= Nothing
-    , testWays     = [] }
+    { testCompiler   = "stage2"
+    , testConfigFile = "testsuite/config/ghc"
+    , testConfigs    = []
+    , testJUnit      = Nothing
+    , testOnly       = Nothing
+    , testOnlyPerf   = False
+    , testSkipPerf   = False
+    , testSpeed      = Fast
+    , testSummary    = Nothing
+    , testVerbosity  = Nothing
+    , testWays       = [] }
 
 readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
 readConfigure = Right $ \flags -> flags { configure = True }
@@ -136,6 +138,12 @@ readTestConfig config =
                         let configs = conf : testConfigs (testArgs flags)
                         in flags { testArgs = (testArgs flags) { testConfigs = configs } }
 
+readTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
+readTestConfigFile filepath = 
+    maybe (Left "Cannot parse test-speed") (Right . set) filepath
+  where
+    set filepath flags =  flags { testArgs = (testArgs flags) { testConfigFile = filepath } } 
+
 readTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readTestJUnit filepath = Right $ \flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }
 
@@ -197,6 +205,8 @@ optDescrs =
       "Generate split objects (requires a full clean rebuild)."
     , Option [] ["test-compiler"] (OptArg readTestCompiler "TEST_COMPILER")
       "Use given compiler [Default=stage2]."
+    , Option [] ["test-config-file"] (OptArg readTestConfigFile "CONFIG_FILE")
+      "congiguration file for testsuite. Default=testsuite/config/ghc"
     , Option [] ["config"] (OptArg readTestConfig "EXTRA_TEST_CONFIG")
       "Configurations to run test, in key=value format."
     , Option [] ["summary-junit"] (OptArg readTestJUnit "TEST_SUMMARY_JUNIT")

diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs
@@ -4,6 +4,7 @@ import GHC
 import Oracles.Setting
 import Rules.Gmp
 import Settings.Builders.Common
+import CommandLine
 
 makeBuilderArgs :: Args
 makeBuilderArgs = do
@@ -23,7 +24,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do
     compiler            <- expr $ fullpath ghc
     checkPpr            <- expr $ fullpath checkPpr
     checkApiAnnotations <- expr $ fullpath checkApiAnnotations
-    return [ "fast"
+    args                <- expr $ userSetting defaultTestArgs
+    return [ setTestSpeed $ testSpeed args
            , "THREADS=" ++ show threads
            , "TEST_HC=" ++ (top -/- compiler)
            , "CHECK_PPR=" ++ (top -/- checkPpr)
@@ -33,3 +35,8 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do
     fullpath :: Package -> Action FilePath
     fullpath pkg = programPath =<< programContext Stage1 pkg
 
+-- | Support for speed of validation 
+setTestSpeed :: TestSpeed -> String
+setTestSpeed Fast    = "fasttest"
+setTestSpeed Average = "test"
+setTestSpeed Slow    = "slowtest" 
diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs
@@ -80,7 +80,6 @@ runTestBuilderArgs = builder RunTest ? do
             , arg "-e", arg $ "config.arch="     ++ show arch
             , arg "-e", arg $ "config.platform=" ++ show platform
 
-            , arg "--config-file=testsuite/config/ghc"
             , arg "--config", arg $ "gs=gs"                           -- Use the default value as in test.mk
             , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg)
             , arg $ "--threads=" ++ show threads
@@ -94,7 +93,8 @@ getTestArgs = do
     bindir          <- expr $ setBinaryDirectory (testCompiler args)
     compiler        <- expr $ setCompiler (testCompiler args)
     globalVerbosity <- shakeVerbosity <$> expr getShakeOptions 
-    let testOnlyArg  = case testOnly args of
+    let configFileArg= ["--config-file=" ++ (testConfigFile args)]
+        testOnlyArg  = case testOnly args of
                            Just cases -> map ("--only=" ++) (words cases)
                            Nothing -> []
         onlyPerfArg  = if testOnlyPerf args
@@ -120,7 +120,7 @@ getTestArgs = do
         haddockArg   = ["--config", "haddock=" ++ show (bindir -/- "haddock")]
         hp2psArg     = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")]
         hpcArg       = ["--config", "hpc=" ++ show (bindir -/- "hpc")]   
-    pure $  testOnlyArg ++ speedArg 
+    pure $  configFileArg ++ testOnlyArg ++ speedArg 
          ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
                       , junitArg, verbosityArg  ] 
          ++ configArgs ++ wayArgs ++  compilerArg ++ ghcPkgArg