Commit 843790ea authored by Alp Mestanogullari's avatar Alp Mestanogullari Committed by Andrey Mokhov

Fix timeout building rule for Linux (#638)

parent bbdd69bd
...@@ -105,15 +105,18 @@ stage2Packages = return [haddock] ...@@ -105,15 +105,18 @@ stage2Packages = return [haddock]
-- | Packages that are built only for the testsuite. -- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package] testsuitePackages :: Action [Package]
testsuitePackages = return [ checkApiAnnotations testsuitePackages = do
, checkPpr win <- windowsHost
, ghci return $
, ghcPkg [ checkApiAnnotations
, hp2ps , checkPpr
, iserv , ghci
, parallel , ghcPkg
, runGhc , hp2ps
, timeout ] , iserv
, parallel
, runGhc ] ++
[ timeout | win ]
-- | Given a 'Context', compute the name of the program that is built in it -- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC -- assuming that the corresponding package's type is 'Program'. For example, GHC
......
...@@ -21,13 +21,15 @@ testRules = do ...@@ -21,13 +21,15 @@ testRules = do
root -/- ghcConfigProgPath ~> do root -/- ghcConfigProgPath ~> do
ghc <- builderPath $ Ghc CompileHs Stage0 ghc <- builderPath $ Ghc CompileHs Stage0
cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath] cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
-- | TODO : Use input test compiler and not just stage2 compiler. -- | TODO : Use input test compiler and not just stage2 compiler.
root -/- ghcConfigPath ~> do root -/- ghcConfigPath ~> do
ghcPath <- needfile Stage1 ghc ghcPath <- needfile Stage1 ghc
need [ root -/- ghcConfigProgPath] need [ root -/- ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath) cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
[ ghcPath ] [ ghcPath ]
root -/- timeoutProgPath ~> timeoutProgBuilder
"validate" ~> do "validate" ~> do
needTestBuilders needTestBuilders
...@@ -38,7 +40,7 @@ testRules = do ...@@ -38,7 +40,7 @@ testRules = do
-- TODO : Should we remove the previosly generated config file? -- TODO : Should we remove the previosly generated config file?
-- Prepare Ghc configuration file for input compiler. -- Prepare Ghc configuration file for input compiler.
need [ root -/- ghcConfigPath ] need [ root -/- ghcConfigPath, root -/- timeoutProgPath ]
-- TODO This approach doesn't work. -- TODO This approach doesn't work.
-- Set environment variables for test's Makefile. -- Set environment variables for test's Makefile.
...@@ -93,13 +95,12 @@ timeoutProgBuilder = do ...@@ -93,13 +95,12 @@ timeoutProgBuilder = do
copyFile prog (root -/- timeoutProgPath) copyFile prog (root -/- timeoutProgPath)
else do else do
python <- builderPath Python python <- builderPath Python
copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py") copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py")
let script = unlines let script = unlines
[ "#!/usr/bin/env sh" [ "#!/usr/bin/env sh"
, "exec " ++ python ++ " $0.py \"$@\"" , "exec " ++ python ++ " $0.py \"$@\""
] ]
liftIO $ do writeFile' (root -/- timeoutProgPath) script
writeFile (root -/- timeoutProgPath) script
makeExecutable (root -/- timeoutProgPath) makeExecutable (root -/- timeoutProgPath)
needTestBuilders :: Action () needTestBuilders :: Action ()
...@@ -108,7 +109,6 @@ needTestBuilders = do ...@@ -108,7 +109,6 @@ needTestBuilders = do
needBuilder $ GhcPkg Update Stage1 needBuilder $ GhcPkg Update Stage1
needBuilder Hpc needBuilder Hpc
needBuilder (Hsc2Hs Stage1) needBuilder (Hsc2Hs Stage1)
timeoutProgBuilder
needTestsuitePackages needTestsuitePackages
-- | Extra flags to send to the Haskell compiler to run tests. -- | Extra flags to send to the Haskell compiler to run tests.
...@@ -160,4 +160,3 @@ needfile stage pkg ...@@ -160,4 +160,3 @@ needfile stage pkg
-- we are going to use, I suppose? -- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic) | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
| otherwise = programPath =<< programContext stage pkg | otherwise = programPath =<< programContext stage pkg
...@@ -103,7 +103,7 @@ getTestArgs = do ...@@ -103,7 +103,7 @@ getTestArgs = do
args <- expr $ userSetting defaultTestArgs args <- expr $ userSetting defaultTestArgs
bindir <- expr $ setBinaryDirectory (testCompiler args) bindir <- expr $ setBinaryDirectory (testCompiler args)
compiler <- expr $ setCompiler (testCompiler args) compiler <- expr $ setCompiler (testCompiler args)
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
let configFileArg= ["--config-file=" ++ (testConfigFile args)] let configFileArg= ["--config-file=" ++ (testConfigFile args)]
testOnlyArg = case testOnly args of testOnlyArg = case testOnly args of
Just cases -> map ("--only=" ++) (words cases) Just cases -> map ("--only=" ++) (words cases)
...@@ -125,30 +125,30 @@ getTestArgs = do ...@@ -125,30 +125,30 @@ getTestArgs = do
verbosityArg = case testVerbosity args of verbosityArg = case testVerbosity args of
Nothing -> Just $ "--verbose=" ++ show (fromEnum globalVerbosity) Nothing -> Just $ "--verbose=" ++ show (fromEnum globalVerbosity)
Just verbosity -> Just $ "--verbose=" ++ verbosity Just verbosity -> Just $ "--verbose=" ++ verbosity
wayArgs = map ("--way=" ++) (testWays args) wayArgs = map ("--way=" ++) (testWays args)
compilerArg = ["--config", "compiler=" ++ show (compiler)] compilerArg = ["--config", "compiler=" ++ show (compiler)]
ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")] ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")]
haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")] haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")]
hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")] hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")]
hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")]
pure $ configFileArg ++ testOnlyArg ++ speedArg pure $ configFileArg ++ testOnlyArg ++ speedArg
++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
, junitArg, verbosityArg ] , junitArg, verbosityArg ]
++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg ++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg
++ haddockArg ++ hp2psArg ++ hpcArg ++ haddockArg ++ hp2psArg ++ hpcArg
-- | Directory to look for Binaries -- | Directory to look for Binaries
-- | We assume that required programs are present in the same binary directory -- | We assume that required programs are present in the same binary directory
-- | in which ghc is stored and that they have their conventional name. -- | in which ghc is stored and that they have their conventional name.
-- | QUESTION : packages can be named different from their conventional names. -- | QUESTION : packages can be named different from their conventional names.
-- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will -- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will
-- | be impossible to search the binary. Only possible way will be to take user -- | be impossible to search the binary. Only possible way will be to take user
-- | inputs for these directory also. boilerplate soes not account for this -- | inputs for these directory also. boilerplate soes not account for this
-- | problem, but simply returns an error. How should we handle such cases? -- | problem, but simply returns an error. How should we handle such cases?
setBinaryDirectory :: String -> Action FilePath setBinaryDirectory :: String -> Action FilePath
setBinaryDirectory "stage0" = setting InstallBinDir setBinaryDirectory "stage0" = setting InstallBinDir
setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0) setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1) setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
setBinaryDirectory compiler = pure $ parentPath compiler setBinaryDirectory compiler = pure $ parentPath compiler
-- | Set Test Compiler -- | Set Test Compiler
...@@ -156,7 +156,7 @@ setCompiler :: String -> Action FilePath ...@@ -156,7 +156,7 @@ setCompiler :: String -> Action FilePath
setCompiler "stage0" = setting SystemGhc setCompiler "stage0" = setting SystemGhc
setCompiler "stage1" = liftM2 (-/-) topDirectory (fullpath Stage0 ghc) setCompiler "stage1" = liftM2 (-/-) topDirectory (fullpath Stage0 ghc)
setCompiler "stage2" = liftM2 (-/-) topDirectory (fullpath Stage1 ghc) setCompiler "stage2" = liftM2 (-/-) topDirectory (fullpath Stage1 ghc)
setCompiler compiler = pure compiler setCompiler compiler = pure compiler
-- | Set speed for test -- | Set speed for test
setTestSpeed :: TestSpeed -> String setTestSpeed :: TestSpeed -> String
...@@ -164,7 +164,7 @@ setTestSpeed Fast = "2" ...@@ -164,7 +164,7 @@ setTestSpeed Fast = "2"
setTestSpeed Average = "1" setTestSpeed Average = "1"
setTestSpeed Slow = "0" setTestSpeed Slow = "0"
-- | Returns parent path of test compiler -- | Returns parent path of test compiler
-- | TODO : Is there a simpler way to find parent directory? -- | TODO : Is there a simpler way to find parent directory?
parentPath :: String -> String parentPath :: String -> String
parentPath path = let upPath = init $ splitOn "/" path parentPath path = let upPath = init $ splitOn "/" path
...@@ -173,4 +173,3 @@ parentPath path = let upPath = init $ splitOn "/" path ...@@ -173,4 +173,3 @@ parentPath path = let upPath = init $ splitOn "/" path
-- | TODO: move to hadrian utilities. -- | TODO: move to hadrian utilities.
fullpath :: Stage -> Package -> Action FilePath fullpath :: Stage -> Package -> Action FilePath
fullpath stage pkg = programPath =<< programContext stage pkg fullpath stage pkg = programPath =<< programContext stage pkg
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