Unverified Commit 44368b61 authored by Andrey Mokhov's avatar Andrey Mokhov Committed by GitHub

Add checkPpr package and infrastructure for testsuite packages (#596)

See #593
parent 1ee62bf5
{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module GHC ( module GHC (
-- * GHC packages -- * GHC packages
array, base, binary, bytestring, cabal, compareSizes, compiler, containers, array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler,
deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc, containers, deepseq, deriveConstants, directory, filepath, genapply,
ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim, ghcTags, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg,
ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin,
integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, integerGmp, integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty,
primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time,
touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,
defaultPackages, defaultPackages, testsuitePackages,
-- * Package information -- * Package information
programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
...@@ -99,6 +99,10 @@ stage1Packages = do ...@@ -99,6 +99,10 @@ stage1Packages = do
stage2Packages :: Action [Package] stage2Packages :: Action [Package]
stage2Packages = return [haddock] stage2Packages = return [haddock]
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = return [checkPpr]
-- | 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
-- built in 'Stage0' is called @ghc-stage1@. If the given package is a -- built in 'Stage0' is called @ghc-stage1@. If the given package is a
......
...@@ -11,14 +11,13 @@ import Hadrian.Utilities ...@@ -11,14 +11,13 @@ import Hadrian.Utilities
-- modify build default build conditions in "UserSettings". -- modify build default build conditions in "UserSettings".
ghcPackages :: [Package] ghcPackages :: [Package]
ghcPackages = ghcPackages =
[ array, base, binary, bytestring, cabal, compareSizes, compiler, containers [ array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler
, deepseq, deriveConstants, directory, filepath, genapply, genprimopcode , containers, deepseq, deriveConstants, directory, filepath, genapply
, ghc, ghcBoot, ghcBootTh, ghcCompact, ghci, ghcPkg, ghcPrim , genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, ghci, ghcPkg, ghcPrim
, ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp , ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp
, integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive , integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive
, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy , process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy
, transformers, unlit, unix, win32, xhtml , transformers, unlit, unix, win32, xhtml ]
]
-- TODO: Optimise by switching to sets of packages. -- TODO: Optimise by switching to sets of packages.
isGhcPackage :: Package -> Bool isGhcPackage :: Package -> Bool
...@@ -30,6 +29,7 @@ base = hsLib "base" ...@@ -30,6 +29,7 @@ base = hsLib "base"
binary = hsLib "binary" binary = hsLib "binary"
bytestring = hsLib "bytestring" bytestring = hsLib "bytestring"
cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal"
checkPpr = hsUtil "check-ppr"
compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes"
compiler = hsTop "ghc" `setPath` "compiler" compiler = hsTop "ghc" `setPath` "compiler"
containers = hsLib "containers" containers = hsLib "containers"
...@@ -57,7 +57,7 @@ hpc = hsLib "hpc" ...@@ -57,7 +57,7 @@ hpc = hsLib "hpc"
hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc"
integerGmp = hsLib "integer-gmp" integerGmp = hsLib "integer-gmp"
integerSimple = hsLib "integer-simple" integerSimple = hsLib "integer-simple"
iservBin = hsUtil "iserv-bin" `setPath` "iserv" iservBin = hsUtil "iserv-bin" `setPath` "iserv"
libffi = cTop "libffi" libffi = cTop "libffi"
mtl = hsLib "mtl" mtl = hsLib "mtl"
parsec = hsLib "parsec" parsec = hsLib "parsec"
...@@ -79,7 +79,6 @@ unix = hsLib "unix" ...@@ -79,7 +79,6 @@ unix = hsLib "unix"
win32 = hsLib "Win32" win32 = hsLib "Win32"
xhtml = hsLib "xhtml" xhtml = hsLib "xhtml"
-- | Construct a Haskell library package, e.g. @array@. -- | Construct a Haskell library package, e.g. @array@.
hsLib :: PackageName -> Package hsLib :: PackageName -> Package
hsLib name = hsLibrary name ("libraries" -/- name) hsLib name = hsLibrary name ("libraries" -/- name)
......
...@@ -31,32 +31,30 @@ allStages = [minBound .. maxBound] ...@@ -31,32 +31,30 @@ allStages = [minBound .. maxBound]
-- 'Stage1Only' flag. -- 'Stage1Only' flag.
topLevelTargets :: Rules () topLevelTargets :: Rules ()
topLevelTargets = action $ do topLevelTargets = action $ do
(programs, libraries) <- partition isProgram <$> stagePackages Stage1 (programs, libraries) <- partition isProgram <$> stagePackages Stage1
pgmNames <- mapM (g Stage1) programs pgmNames <- mapM (g Stage1) programs
libNames <- mapM (g Stage1) libraries libNames <- mapM (g Stage1) libraries
verbosity <- getVerbosity verbosity <- getVerbosity
when (verbosity >= Loud) $ do when (verbosity >= Loud) $ do
putNormal "Building stage2" putNormal "Building stage2"
putNormal . unlines $ putNormal . unlines $
[ "| Building Programs: " ++ intercalate ", " pgmNames [ "| Building Programs : " ++ intercalate ", " pgmNames
, "| Building Libraries: " ++ intercalate ", " libNames , "| Building Libraries: " ++ intercalate ", " libNames ]
]
targets <- mapM (f Stage1) =<< stagePackages Stage1
targets <- mapM (f Stage1) =<< stagePackages Stage1 need targets
need targets where
-- either the package database config file for libraries or
where -- the programPath for programs. However this still does
-- either the package database config file for libraries or -- not support multiple targets, where a cabal package has
-- the programPath for programs. However this still does -- a library /and/ a program.
-- not support multiple targets, where a cabal package has f :: Stage -> Package -> Action FilePath
-- a library /and/ a program. f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v"))
f :: Stage -> Package -> Action FilePath | otherwise = programPath =<< programContext stage pkg
f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v")) g :: Stage -> Package -> Action String
| otherwise = programPath =<< programContext stage pkg g stage pkg | isLibrary pkg = return $ pkgName pkg
g :: Stage -> Package -> Action String | otherwise = programName (Context stage pkg (read "v"))
g stage pkg | isLibrary pkg = return $ pkgName pkg
| otherwise = programName (Context stage pkg (read "v"))
-- TODO: Get rid of the @includeGhciLib@ hack. -- TODO: Get rid of the @includeGhciLib@ hack.
-- | Return the list of targets associated with a given 'Stage' and 'Package'. -- | Return the list of targets associated with a given 'Stage' and 'Package'.
......
...@@ -19,42 +19,42 @@ buildProgram :: [(Resource, Int)] -> Rules () ...@@ -19,42 +19,42 @@ buildProgram :: [(Resource, Int)] -> Rules ()
buildProgram rs = do buildProgram rs = do
root <- buildRootRules root <- buildRootRules
forM_ [Stage0 ..] $ \stage -> forM_ [Stage0 ..] $ \stage ->
[ root -/- stageString stage -/- "bin" -/- "*" [ root -/- stageString stage -/- "bin" -/- "*"
, root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do , root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do
-- This is quite inefficient, but we can't access 'programName' from
-- 'Rules', because it is an 'Action' depending on an oracle.
sPackages <- filter isProgram <$> stagePackages stage
tPackages <- testsuitePackages
-- TODO: Shall we use Stage2 for testsuite packages instead?
let allPackages = sPackages
++ if stage == Stage1 then tPackages else []
nameToCtxList <- forM allPackages $ \pkg -> do
let ctx = vanillaContext stage pkg
name <- programName ctx
return (name <.> exe, ctx)
-- quite inefficient. But we can't access the programName from case lookup (takeFileName bin) nameToCtxList of
-- Rules, as it's an Action, due to being backed by an Oracle. Nothing -> error $ "Unknown program " ++ show bin
activeProgramPackages <- filter isProgram <$> stagePackages stage Just (Context {..}) -> do
nameToCtxList <- forM activeProgramPackages $ \pkg -> do -- Custom dependencies: this should be modeled better in the
let ctx = vanillaContext stage pkg -- Cabal file somehow.
name <- programName ctx -- TODO: Is this still needed? See 'runtimeDependencies'.
return (name <.> exe, ctx) when (package == hsc2hs) $ do
-- 'Hsc2hs' needs the @template-hsc.h@ file.
template <- templateHscPath stage
need [template]
when (package == ghc) $ do
-- GHC depends on @settings@, @platformConstants@,
-- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@.
need =<< ghcDeps stage
case lookup (takeFileName bin) nameToCtxList of cross <- crossCompiling
Nothing -> fail "Unknown program" -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
Just (Context {..}) -> do case (cross, stage) of
-- Rules for programs built in 'buildRoot' (True, s) | s > Stage0 -> do
srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
-- Custom dependencies: this should be modeled better in the cabal file somehow. copyFile (srcDir -/- takeFileName bin) bin
_ -> buildBinary rs bin =<< programContext stage package
when (package == hsc2hs) $ do
-- hsc2hs needs the template-hsc.h file
tmpl <- templateHscPath stage
need [tmpl]
when (package == ghc) $ do
-- ghc depends on settings, platformConstants, llvm-targets
-- ghc-usage.txt, ghci-usage.txt
need =<< ghcDeps stage
cross <- crossCompiling
-- for cross compiler, copy the stage0/bin/<pgm>
-- into stage1/bin/
case (cross, stage) of
(True, s) | s > Stage0 -> do
srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
copyFile (srcDir -/- takeFileName bin) bin
_ -> buildBinary rs bin =<< programContext stage package
-- Rules for the GHC package, which is built 'inplace'
buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
buildBinary rs bin context@Context {..} = do buildBinary rs bin context@Context {..} = do
......
...@@ -2,7 +2,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where ...@@ -2,7 +2,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
import Base import Base
import Expression import Expression
import GHC.Packages import GHC
import Oracles.Flag import Oracles.Flag
import Oracles.Setting import Oracles.Setting
import Target import Target
...@@ -13,7 +13,6 @@ import System.Environment ...@@ -13,7 +13,6 @@ import System.Environment
-- TODO: clean up after testing -- TODO: clean up after testing
testRules :: Rules () testRules :: Rules ()
testRules = do testRules = do
root <- buildRootRules root <- buildRootRules
root -/- timeoutPyPath ~> do root -/- timeoutPyPath ~> do
...@@ -66,12 +65,11 @@ testRules = do ...@@ -66,12 +65,11 @@ testRules = do
needTestBuilders :: Action () needTestBuilders :: Action ()
needTestBuilders = do needTestBuilders = do
needBuilder $ Ghc CompileHs Stage2 needBuilder $ Ghc CompileHs Stage2
needBuilder $ GhcPkg Update Stage1 needBuilder $ GhcPkg Update Stage1
needBuilder Hp2Ps needBuilder Hp2Ps
needBuilder Hpc needBuilder Hpc
needBuilder (Hsc2Hs Stage1) needBuilder (Hsc2Hs Stage1)
-- | 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
......
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