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