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]
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = return [ checkApiAnnotations
, checkPpr
, ghci
, ghcPkg
, hp2ps
, iserv
, parallel
, runGhc
, timeout ]
testsuitePackages = do
win <- windowsHost
return $
[ checkApiAnnotations
, checkPpr
, ghci
, ghcPkg
, hp2ps
, iserv
, parallel
, runGhc ] ++
[ timeout | win ]
-- | 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
......
......@@ -21,13 +21,15 @@ testRules = do
root -/- ghcConfigProgPath ~> do
ghc <- builderPath $ Ghc CompileHs Stage0
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
ghcPath <- needfile Stage1 ghc
need [ root -/- ghcConfigProgPath]
cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
[ ghcPath ]
[ ghcPath ]
root -/- timeoutProgPath ~> timeoutProgBuilder
"validate" ~> do
needTestBuilders
......@@ -38,7 +40,7 @@ testRules = do
-- TODO : Should we remove the previosly generated config file?
-- Prepare Ghc configuration file for input compiler.
need [ root -/- ghcConfigPath ]
need [ root -/- ghcConfigPath, root -/- timeoutProgPath ]
-- TODO This approach doesn't work.
-- Set environment variables for test's Makefile.
......@@ -93,13 +95,12 @@ timeoutProgBuilder = do
copyFile prog (root -/- timeoutProgPath)
else do
python <- builderPath Python
copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py")
copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py")
let script = unlines
[ "#!/usr/bin/env sh"
, "exec " ++ python ++ " $0.py \"$@\""
]
liftIO $ do
writeFile (root -/- timeoutProgPath) script
writeFile' (root -/- timeoutProgPath) script
makeExecutable (root -/- timeoutProgPath)
needTestBuilders :: Action ()
......@@ -108,7 +109,6 @@ needTestBuilders = do
needBuilder $ GhcPkg Update Stage1
needBuilder Hpc
needBuilder (Hsc2Hs Stage1)
timeoutProgBuilder
needTestsuitePackages
-- | Extra flags to send to the Haskell compiler to run tests.
......@@ -160,4 +160,3 @@ needfile stage pkg
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
| otherwise = programPath =<< programContext stage pkg
......@@ -103,7 +103,7 @@ getTestArgs = do
args <- expr $ userSetting defaultTestArgs
bindir <- expr $ setBinaryDirectory (testCompiler args)
compiler <- expr $ setCompiler (testCompiler args)
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
globalVerbosity <- shakeVerbosity <$> expr getShakeOptions
let configFileArg= ["--config-file=" ++ (testConfigFile args)]
testOnlyArg = case testOnly args of
Just cases -> map ("--only=" ++) (words cases)
......@@ -125,30 +125,30 @@ getTestArgs = do
verbosityArg = case testVerbosity args of
Nothing -> Just $ "--verbose=" ++ show (fromEnum globalVerbosity)
Just verbosity -> Just $ "--verbose=" ++ verbosity
wayArgs = map ("--way=" ++) (testWays args)
wayArgs = map ("--way=" ++) (testWays args)
compilerArg = ["--config", "compiler=" ++ show (compiler)]
ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")]
haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")]
hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")]
hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")]
pure $ configFileArg ++ testOnlyArg ++ speedArg
hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")]
pure $ configFileArg ++ testOnlyArg ++ speedArg
++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg
, junitArg, verbosityArg ]
, junitArg, verbosityArg ]
++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg
++ haddockArg ++ hp2psArg ++ hpcArg
-- | 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.
-- | 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
-- | 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
-- | 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
-- | problem, but simply returns an error. How should we handle such cases?
setBinaryDirectory :: String -> Action FilePath
setBinaryDirectory "stage0" = setting InstallBinDir
setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0)
setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1)
setBinaryDirectory compiler = pure $ parentPath compiler
-- | Set Test Compiler
......@@ -156,7 +156,7 @@ setCompiler :: String -> Action FilePath
setCompiler "stage0" = setting SystemGhc
setCompiler "stage1" = liftM2 (-/-) topDirectory (fullpath Stage0 ghc)
setCompiler "stage2" = liftM2 (-/-) topDirectory (fullpath Stage1 ghc)
setCompiler compiler = pure compiler
setCompiler compiler = pure compiler
-- | Set speed for test
setTestSpeed :: TestSpeed -> String
......@@ -164,7 +164,7 @@ setTestSpeed Fast = "2"
setTestSpeed Average = "1"
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?
parentPath :: String -> String
parentPath path = let upPath = init $ splitOn "/" path
......@@ -173,4 +173,3 @@ parentPath path = let upPath = init $ splitOn "/" path
-- | TODO: move to hadrian utilities.
fullpath :: Stage -> Package -> Action FilePath
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