Commit d4b9c1fb authored by Chitrak Raj Gupta's avatar Chitrak Raj Gupta Committed by Andrey Mokhov

Remove more validation errors (#628)

* Improved GhcCabal library arguments

* setting enviornment for extra programs

* Copied necessary programs

* Added support to generate ghcconfig
  We will need it for properly configuring python command

Some revisions

* Using ghcconfig file for test parameters

* minor changes

* minor revision

* Update Ghc.hs
parent 233a6389
......@@ -50,6 +50,7 @@ executable hadrian
, Oracles.Flag
, Oracles.Setting
, Oracles.ModuleFiles
, Oracles.TestSettings
, Rules
, Rules.BinaryDist
, Rules.Clean
......
......@@ -107,10 +107,13 @@ stage2Packages = return [haddock]
testsuitePackages :: Action [Package]
testsuitePackages = return [ checkApiAnnotations
, checkPpr
, ghci
, ghcPkg
, parallel
, hp2ps
, timeout ]
, iserv
, parallel
, runGhc
, timeout ]
-- | 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
......
-- | We create a file <root>/test/ghcconfig containing configuration of test
-- | compiler. We need to search this file for required keys and setting
-- | required for testsuite e.g. WORDSIZE, HOSTOS etc.
module Oracles.TestSettings (
TestSetting (..), testSetting, testRTSSettings
) where
import Hadrian.Oracles.TextFile
import Base
testConfigFile :: Action FilePath
testConfigFile = buildRoot <&> (-/- "test/ghcconfig")
-- | Test settings that are obtained from ghcconfig file.
data TestSetting = TestHostOS
| TestWORDSIZE
| TestTARGETPLATFORM
| TestTargetOS_CPP
| TestTargetARCH_CPP
| TestGhcStage
| TestGhcDebugged
| TestGhcWithNativeCodeGen
| TestGhcWithInterpreter
| TestGhcUnregisterised
| TestGhcWithSMP
| TestGhcDynamicByDefault
| TestGhcDynamic
| TestGhcProfiled
| TestAR
| TestCLANG
| TestLLC
| TestTEST_CC
| TestGhcPackageDbFlag
| TestMinGhcVersion711
| TestMinGhcVersion801
deriving (Show)
-- | Lookup for testsettings in ghcconfig file
-- | To obtain RTS Ways supported in ghcconfig file, use testRTSSettings.
testSetting :: TestSetting -> Action String
testSetting key = do
file <- testConfigFile
lookupValueOrError file $ case key of
TestHostOS -> "HostOS"
TestWORDSIZE -> "WORDSIZE"
TestTARGETPLATFORM -> "TARGETPLATFORM"
TestTargetOS_CPP -> "TargetOS_CPP"
TestTargetARCH_CPP -> "TargetARCH_CPP"
TestGhcStage -> "GhcStage"
TestGhcDebugged -> "GhcDebugged"
TestGhcWithNativeCodeGen -> "GhcWithNativeCodeGen"
TestGhcWithInterpreter -> "GhcWithInterpreter"
TestGhcUnregisterised -> "GhcUnregisterised"
TestGhcWithSMP -> "GhcWithSMP"
TestGhcDynamicByDefault -> "GhcDynamicByDefault"
TestGhcDynamic -> "GhcDynamic"
TestGhcProfiled -> "GhcProfiled"
TestAR -> "AR"
TestCLANG -> "CLANG"
TestLLC -> "LLC"
TestTEST_CC -> "TEST_CC"
TestGhcPackageDbFlag -> "GhcPackageDbFlag"
TestMinGhcVersion711 -> "MinGhcVersion711"
TestMinGhcVersion801 -> "MinGhcVersion801"
-- | Get the RTS ways of the test compiler
testRTSSettings :: Action [String]
testRTSSettings = do
file <- testConfigFile
fmap words $ lookupValueOrError file "GhcRTSWays"
......@@ -15,6 +15,20 @@ import System.Environment
-- TODO: clean up after testing
testRules :: Rules ()
testRules = do
root <- buildRootRules
-- | Using program shipped with testsuite to generate ghcconfig file.
root -/- ghcConfigProgPath ~> do
ghc <- builderPath $ Ghc CompileHs Stage0
cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]
-- | 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 ]
"validate" ~> do
needTestBuilders
build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
......@@ -22,6 +36,10 @@ testRules = do
"test" ~> do
needTestBuilders
-- TODO : Should we remove the previosly generated config file?
-- Prepare Ghc configuration file for input compiler.
need [ root -/- ghcConfigPath ]
-- TODO This approach doesn't work.
-- Set environment variables for test's Makefile.
env <- sequence
......@@ -29,33 +47,38 @@ testRules = do
, builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
, AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
makePath <- builderPath $ Make ""
top <- topDirectory
ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
ghcFlags <- runTestGhcFlags
makePath <- builderPath $ Make ""
top <- topDirectory
ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
ghcFlags <- runTestGhcFlags
checkPprPath <- (top -/-) <$> needfile Stage1 checkPpr
annotationsPath <- (top -/-) <$> needfile Stage1 checkApiAnnotations
-- Set environment variables for test's Makefile.
liftIO $ do
setEnv "MAKE" makePath
setEnv "TEST_HC" ghcPath
setEnv "TEST_HC_OPTS" ghcFlags
setEnv "CHECK_PPR" checkPprPath
setEnv "CHECK_API_ANNOTATIONS" annotationsPath
-- Execute the test target.
buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
-- | Build extra programs required by testsuite
needTestsuiteBuilders :: Action ()
needTestsuiteBuilders = do
targets <- mapM (needfile Stage1) =<< testsuitePackages
-- | Build extra programs and libraries required by testsuite
needTestsuitePackages :: Action ()
needTestsuitePackages = do
targets <- mapM (needfile Stage1) =<< testsuitePackages
binPath <- stageBinPath Stage1
libPath <- stageLibPath Stage1
iservPath <- needfile Stage1 iserv
runhaskellPath <- needfile Stage1 runGhc
need targets
where
needfile :: Stage -> Package -> Action FilePath
needfile stage pkg
-- TODO (Alp): we might sometimes need more than vanilla!
-- This should therefore depend on what test ways
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (vanillaContext stage pkg)
| otherwise = programPath =<< programContext stage pkg
-- | We need to copy iserv bin to lib/bin as this is where testsuite looks
-- | for iserv. Also, using runhaskell gives different stdout due to
-- | difference in program name. This causes StdMismatch errors.
copyFile iservPath $ libPath -/- "bin/ghc-iserv"
copyFile runhaskellPath $ binPath -/- "runghc"
-- | Build the timeout program.
-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
......@@ -85,8 +108,8 @@ needTestBuilders = do
needBuilder $ GhcPkg Update Stage1
needBuilder Hpc
needBuilder (Hsc2Hs Stage1)
needTestsuiteBuilders
timeoutProgBuilder
needTestsuitePackages
-- | Extra flags to send to the Haskell compiler to run tests.
runTestGhcFlags :: Action String
......@@ -120,3 +143,21 @@ runTestGhcFlags = do
timeoutProgPath :: FilePath
timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
ghcConfigHsPath :: FilePath
ghcConfigHsPath = "testsuite/mk/ghc-config.hs"
ghcConfigProgPath :: FilePath
ghcConfigProgPath = "test/bin/ghc-config"
ghcConfigPath :: FilePath
ghcConfigPath = "test/ghcconfig"
needfile :: Stage -> Package -> Action FilePath
needfile stage pkg
--TODO (Alp): we might sometimes need more than vanilla!
-- This should therefore depend on what test ways
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
| otherwise = programPath =<< programContext stage pkg
......@@ -57,21 +57,25 @@ ghcCabalBuilderArgs = mconcat
-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
-- TODO: should `elem` be `wayUnit`?
-- This approach still doesn't work. Previously libraries were build only in the
-- Default flavours and not using context.
libraryArgs :: Args
libraryArgs = do
ways <- getLibraryWays
flavourWays <- getLibraryWays
contextWay <- getWay
withGhci <- expr ghcWithInterpreter
dynPrograms <- dynamicGhcPrograms <$> expr flavour
let ways = flavourWays ++ [contextWay]
pure [ if vanilla `elem` ways
then "--enable-library-vanilla"
else "--disable-library-vanilla"
, if vanilla `elem` ways && withGhci && not dynPrograms
then "--enable-library-for-ghci"
else "--disable-library-for-ghci"
, if profiling `elem` ways
, if or [Profiling `wayUnit` way | way <- ways]
then "--enable-library-profiling"
else "--disable-library-profiling"
, if dynamic `elem` ways
, if or [Dynamic `wayUnit` way | way <- ways]
then "--enable-shared"
else "--disable-shared" ]
......
module Settings.Builders.RunTest (runTestBuilderArgs) where
import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..))
import Context
import Flavour
import GHC
import Hadrian.Utilities
import Oracles.Setting (setting)
import Oracles.TestSettings
import Rules.Test
import Settings.Builders.Common
......@@ -12,6 +14,14 @@ oneZero :: String -> Bool -> String
oneZero lbl False = lbl ++ "=0"
oneZero lbl True = lbl ++ "=1"
stringToBool :: String -> Bool
stringToBool "YES" = True
stringToBool "NO" = False
-- | An abstraction to get boolean value of some settings
getBooleanSetting :: TestSetting -> Action Bool
getBooleanSetting key = fmap stringToBool $ testSetting key
-- Arguments to send to the runtest.py script.
--
-- A lot of this mirrors what's achieved at testsuite/mk/test.mk.
......@@ -23,23 +33,25 @@ runTestBuilderArgs = builder RunTest ? do
| pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
flav <- expr flavour
rtsways <- rtsWays flav
rtsways <- expr $ testRTSSettings
libways <- libraryWays flav
let hasRtsWay w = elem w rtsways
hasLibWay w = elem w libways
debugged = ghcDebugged flav
withNativeCodeGen <- expr ghcWithNativeCodeGen
withInterpreter <- expr ghcWithInterpreter
unregisterised <- getFlag GhcUnregisterised
withSMP <- expr ghcWithSMP
hasDynamic <- expr $ getBooleanSetting TestGhcDynamic
hasDynamicByDefault <- expr $ getBooleanSetting TestGhcDynamicByDefault
withNativeCodeGen <- expr $ getBooleanSetting TestGhcWithNativeCodeGen
withInterpreter <- expr $ getBooleanSetting TestGhcWithInterpreter
unregisterised <- expr $ getBooleanSetting TestGhcUnregisterised
withSMP <- expr $ getBooleanSetting TestGhcWithSMP
windows <- expr windowsHost
darwin <- expr osxHost
threads <- shakeThreads <$> expr getShakeOptions
os <- expr $ setting TargetOs
arch <- expr $ setting TargetArch
platform <- expr $ setting TargetPlatform
os <- expr $ testSetting TestHostOS
arch <- expr $ testSetting TestTargetARCH_CPP
platform <- expr $ testSetting TestTARGETPLATFORM
wordsize <- expr $ testSetting TestWORDSIZE
top <- expr topDirectory
ghcFlags <- expr runTestGhcFlags
timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath)
......@@ -51,7 +63,6 @@ runTestBuilderArgs = builder RunTest ? do
, pure ["--rootdir=" ++ test | test <- libTests]
, arg "-e", arg $ "windows=" ++ show windows
, arg "-e", arg $ "darwin=" ++ show darwin
, arg "-e", arg $ "config.speed=2" -- Use default value in GHC's test.mk
, arg "-e", arg $ "config.local=True"
, arg "-e", arg $ "config.cleanup=False" -- Don't clean up.
, arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
......@@ -62,20 +73,20 @@ runTestBuilderArgs = builder RunTest ? do
, arg "-e", arg $ "config.unregisterised=" ++ show unregisterised
, arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags
, arg "-e", arg $ oneZero "ghc_with_dynamic_rts" (hasRtsWay dynamic)
, arg "-e", arg $ oneZero "ghc_with_threaded_rts" (hasRtsWay threaded)
, arg "-e", arg $ oneZero "ghc_with_dynamic_rts" (hasRtsWay "dyn")
, arg "-e", arg $ oneZero "ghc_with_threaded_rts" (hasRtsWay "thr")
, arg "-e", arg $ oneZero "config.have_vanilla" (hasLibWay vanilla)
, arg "-e", arg $ oneZero "config.have_dynamic" (hasLibWay dynamic)
, arg "-e", arg $ oneZero "config.have_profiling" (hasLibWay profiling)
, arg "-e", arg $ oneZero "ghc_with_smp" withSMP
, arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM
, arg "-e", arg $ "config.ghc_dynamic_by_default=False" -- TODO: support dynamic
, arg "-e", arg $ "config.ghc_dynamic=False" -- TODO: support dynamic
, arg "-e", arg $ "config.ghc_dynamic_by_default=" ++ show hasDynamicByDefault
, arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic
, arg "-e", arg $ "config.in_tree_compiler=True" -- Use default value, see https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk
, arg "-e", arg $ "config.top=" ++ show (top -/- "testsuite")
, arg "-e", arg $ "config.wordsize=\"64\""
, arg "-e", arg $ "config.wordsize=" ++ show wordsize
, arg "-e", arg $ "config.os=" ++ show os
, arg "-e", arg $ "config.arch=" ++ show arch
, arg "-e", arg $ "config.platform=" ++ show platform
......
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