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 ...@@ -50,6 +50,7 @@ executable hadrian
, Oracles.Flag , Oracles.Flag
, Oracles.Setting , Oracles.Setting
, Oracles.ModuleFiles , Oracles.ModuleFiles
, Oracles.TestSettings
, Rules , Rules
, Rules.BinaryDist , Rules.BinaryDist
, Rules.Clean , Rules.Clean
......
...@@ -107,10 +107,13 @@ stage2Packages = return [haddock] ...@@ -107,10 +107,13 @@ stage2Packages = return [haddock]
testsuitePackages :: Action [Package] testsuitePackages :: Action [Package]
testsuitePackages = return [ checkApiAnnotations testsuitePackages = return [ checkApiAnnotations
, checkPpr , checkPpr
, ghci
, ghcPkg , ghcPkg
, parallel
, hp2ps , hp2ps
, timeout ] , iserv
, parallel
, runGhc
, timeout ]
-- | 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
......
-- | 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 ...@@ -15,6 +15,20 @@ import System.Environment
-- TODO: clean up after testing -- TODO: clean up after testing
testRules :: Rules () testRules :: Rules ()
testRules = do 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 "validate" ~> do
needTestBuilders needTestBuilders
build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
...@@ -22,6 +36,10 @@ testRules = do ...@@ -22,6 +36,10 @@ testRules = do
"test" ~> do "test" ~> do
needTestBuilders 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. -- TODO This approach doesn't work.
-- Set environment variables for test's Makefile. -- Set environment variables for test's Makefile.
env <- sequence env <- sequence
...@@ -29,33 +47,38 @@ testRules = do ...@@ -29,33 +47,38 @@ testRules = do
, builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2 , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
, AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ] , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]
makePath <- builderPath $ Make "" makePath <- builderPath $ Make ""
top <- topDirectory top <- topDirectory
ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2) ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
ghcFlags <- runTestGhcFlags ghcFlags <- runTestGhcFlags
checkPprPath <- (top -/-) <$> needfile Stage1 checkPpr
annotationsPath <- (top -/-) <$> needfile Stage1 checkApiAnnotations
-- Set environment variables for test's Makefile. -- Set environment variables for test's Makefile.
liftIO $ do liftIO $ do
setEnv "MAKE" makePath setEnv "MAKE" makePath
setEnv "TEST_HC" ghcPath setEnv "TEST_HC" ghcPath
setEnv "TEST_HC_OPTS" ghcFlags setEnv "TEST_HC_OPTS" ghcFlags
setEnv "CHECK_PPR" checkPprPath
setEnv "CHECK_API_ANNOTATIONS" annotationsPath
-- Execute the test target. -- Execute the test target.
buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] [] buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
-- | Build extra programs required by testsuite -- | Build extra programs and libraries required by testsuite
needTestsuiteBuilders :: Action () needTestsuitePackages :: Action ()
needTestsuiteBuilders = do needTestsuitePackages = do
targets <- mapM (needfile Stage1) =<< testsuitePackages targets <- mapM (needfile Stage1) =<< testsuitePackages
binPath <- stageBinPath Stage1
libPath <- stageLibPath Stage1
iservPath <- needfile Stage1 iserv
runhaskellPath <- needfile Stage1 runGhc
need targets need targets
where -- | We need to copy iserv bin to lib/bin as this is where testsuite looks
needfile :: Stage -> Package -> Action FilePath -- | for iserv. Also, using runhaskell gives different stdout due to
needfile stage pkg -- | difference in program name. This causes StdMismatch errors.
-- TODO (Alp): we might sometimes need more than vanilla! copyFile iservPath $ libPath -/- "bin/ghc-iserv"
-- This should therefore depend on what test ways copyFile runhaskellPath $ binPath -/- "runghc"
-- we are going to use, I suppose?
| isLibrary pkg = pkgConfFile (vanillaContext stage pkg)
| otherwise = programPath =<< programContext stage pkg
-- | Build the timeout program. -- | Build the timeout program.
-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
...@@ -85,8 +108,8 @@ needTestBuilders = do ...@@ -85,8 +108,8 @@ needTestBuilders = do
needBuilder $ GhcPkg Update Stage1 needBuilder $ GhcPkg Update Stage1
needBuilder Hpc needBuilder Hpc
needBuilder (Hsc2Hs Stage1) needBuilder (Hsc2Hs Stage1)
needTestsuiteBuilders
timeoutProgBuilder timeoutProgBuilder
needTestsuitePackages
-- | Extra flags to send to the Haskell compiler to run tests. -- | Extra flags to send to the Haskell compiler to run tests.
runTestGhcFlags :: Action String runTestGhcFlags :: Action String
...@@ -120,3 +143,21 @@ runTestGhcFlags = do ...@@ -120,3 +143,21 @@ runTestGhcFlags = do
timeoutProgPath :: FilePath timeoutProgPath :: FilePath
timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe 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 ...@@ -57,21 +57,25 @@ ghcCabalBuilderArgs = mconcat
-- TODO: Isn't vanilla always built? If yes, some conditions are redundant. -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci? -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
-- TODO: should `elem` be `wayUnit`? -- 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 :: Args
libraryArgs = do libraryArgs = do
ways <- getLibraryWays flavourWays <- getLibraryWays
contextWay <- getWay
withGhci <- expr ghcWithInterpreter withGhci <- expr ghcWithInterpreter
dynPrograms <- dynamicGhcPrograms <$> expr flavour dynPrograms <- dynamicGhcPrograms <$> expr flavour
let ways = flavourWays ++ [contextWay]
pure [ if vanilla `elem` ways pure [ if vanilla `elem` ways
then "--enable-library-vanilla" then "--enable-library-vanilla"
else "--disable-library-vanilla" else "--disable-library-vanilla"
, if vanilla `elem` ways && withGhci && not dynPrograms , if vanilla `elem` ways && withGhci && not dynPrograms
then "--enable-library-for-ghci" then "--enable-library-for-ghci"
else "--disable-library-for-ghci" else "--disable-library-for-ghci"
, if profiling `elem` ways , if or [Profiling `wayUnit` way | way <- ways]
then "--enable-library-profiling" then "--enable-library-profiling"
else "--disable-library-profiling" else "--disable-library-profiling"
, if dynamic `elem` ways , if or [Dynamic `wayUnit` way | way <- ways]
then "--enable-shared" then "--enable-shared"
else "--disable-shared" ] else "--disable-shared" ]
......
module Settings.Builders.RunTest (runTestBuilderArgs) where module Settings.Builders.RunTest (runTestBuilderArgs) where
import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..)) import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..))
import Context
import Flavour import Flavour
import GHC import GHC
import Hadrian.Utilities import Hadrian.Utilities
import Oracles.Setting (setting) import Oracles.Setting (setting)
import Oracles.TestSettings
import Rules.Test import Rules.Test
import Settings.Builders.Common import Settings.Builders.Common
...@@ -12,6 +14,14 @@ oneZero :: String -> Bool -> String ...@@ -12,6 +14,14 @@ oneZero :: String -> Bool -> String
oneZero lbl False = lbl ++ "=0" oneZero lbl False = lbl ++ "=0"
oneZero lbl True = lbl ++ "=1" 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. -- Arguments to send to the runtest.py script.
-- --
-- A lot of this mirrors what's achieved at testsuite/mk/test.mk. -- A lot of this mirrors what's achieved at testsuite/mk/test.mk.
...@@ -23,23 +33,25 @@ runTestBuilderArgs = builder RunTest ? do ...@@ -23,23 +33,25 @@ runTestBuilderArgs = builder RunTest ? do
| pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ] | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
flav <- expr flavour flav <- expr flavour
rtsways <- rtsWays flav rtsways <- expr $ testRTSSettings
libways <- libraryWays flav libways <- libraryWays flav
let hasRtsWay w = elem w rtsways let hasRtsWay w = elem w rtsways
hasLibWay w = elem w libways hasLibWay w = elem w libways
debugged = ghcDebugged flav debugged = ghcDebugged flav
hasDynamic <- expr $ getBooleanSetting TestGhcDynamic
withNativeCodeGen <- expr ghcWithNativeCodeGen hasDynamicByDefault <- expr $ getBooleanSetting TestGhcDynamicByDefault
withInterpreter <- expr ghcWithInterpreter withNativeCodeGen <- expr $ getBooleanSetting TestGhcWithNativeCodeGen
unregisterised <- getFlag GhcUnregisterised withInterpreter <- expr $ getBooleanSetting TestGhcWithInterpreter
withSMP <- expr ghcWithSMP unregisterised <- expr $ getBooleanSetting TestGhcUnregisterised
withSMP <- expr $ getBooleanSetting TestGhcWithSMP
windows <- expr windowsHost windows <- expr windowsHost
darwin <- expr osxHost darwin <- expr osxHost
threads <- shakeThreads <$> expr getShakeOptions threads <- shakeThreads <$> expr getShakeOptions
os <- expr $ setting TargetOs os <- expr $ testSetting TestHostOS
arch <- expr $ setting TargetArch arch <- expr $ testSetting TestTargetARCH_CPP
platform <- expr $ setting TargetPlatform platform <- expr $ testSetting TestTARGETPLATFORM
wordsize <- expr $ testSetting TestWORDSIZE
top <- expr topDirectory top <- expr topDirectory
ghcFlags <- expr runTestGhcFlags ghcFlags <- expr runTestGhcFlags
timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath) timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath)
...@@ -51,7 +63,6 @@ runTestBuilderArgs = builder RunTest ? do ...@@ -51,7 +63,6 @@ runTestBuilderArgs = builder RunTest ? do
, pure ["--rootdir=" ++ test | test <- libTests] , pure ["--rootdir=" ++ test | test <- libTests]
, arg "-e", arg $ "windows=" ++ show windows , arg "-e", arg $ "windows=" ++ show windows
, arg "-e", arg $ "darwin=" ++ show darwin , 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.local=True"
, arg "-e", arg $ "config.cleanup=False" -- Don't clean up. , arg "-e", arg $ "config.cleanup=False" -- Don't clean up.
, arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged) , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged)
...@@ -62,20 +73,20 @@ runTestBuilderArgs = builder RunTest ? do ...@@ -62,20 +73,20 @@ runTestBuilderArgs = builder RunTest ? do
, arg "-e", arg $ "config.unregisterised=" ++ show unregisterised , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised
, arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags , 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_dynamic_rts" (hasRtsWay "dyn")
, arg "-e", arg $ oneZero "ghc_with_threaded_rts" (hasRtsWay threaded) , 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_vanilla" (hasLibWay vanilla)
, arg "-e", arg $ oneZero "config.have_dynamic" (hasLibWay dynamic) , arg "-e", arg $ oneZero "config.have_dynamic" (hasLibWay dynamic)
, arg "-e", arg $ oneZero "config.have_profiling" (hasLibWay profiling) , arg "-e", arg $ oneZero "config.have_profiling" (hasLibWay profiling)
, arg "-e", arg $ oneZero "ghc_with_smp" withSMP , arg "-e", arg $ oneZero "ghc_with_smp" withSMP
, arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM , 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_by_default=" ++ show hasDynamicByDefault
, arg "-e", arg $ "config.ghc_dynamic=False" -- TODO: support dynamic , 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.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.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.os=" ++ show os
, arg "-e", arg $ "config.arch=" ++ show arch , arg "-e", arg $ "config.arch=" ++ show arch
, arg "-e", arg $ "config.platform=" ++ show platform , 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