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

hadrian.cabal

@@ -50,6 +50,7 @@ executable hadrian
                        , Oracles.Flag
                        , Oracles.Setting
                        , Oracles.ModuleFiles
+                       , Oracles.TestSettings
                        , Rules
                        , Rules.BinaryDist
                        , Rules.Clean

src/GHC.hs

@@ -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

src/Oracles/TestSettings.hs

+-- | 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"
+

src/Rules/Test.hs

@@ -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
+

src/Settings/Builders/GhcCabal.hs

@@ -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" ]
 

src/Settings/Builders/RunTest.hs

 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