From 44368b61d78b4ccf4e5aa6312cd64f4b2466efc4 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Sat, 12 May 2018 00:28:56 +0200 Subject: [PATCH] Add checkPpr package and infrastructure for testsuite packages (#596) See #593 --- src/GHC.hs | 16 +++++++---- src/GHC/Packages.hs | 13 ++++----- src/Rules.hs | 44 ++++++++++++++-------------- src/Rules/Program.hs | 68 ++++++++++++++++++++++---------------------- src/Rules/Test.hs | 14 ++++----- 5 files changed, 77 insertions(+), 78 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 5c690ddf5e..61bfb7f8a8 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -1,14 +1,14 @@ {-# 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 diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 68c93ec52e..79830dc0a5 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -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) diff --git a/src/Rules.hs b/src/Rules.hs index 1ecb4768f3..7533a2757c 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -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'. diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 67a310f852..aebaaabc84 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -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/ - -- 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/@ 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 diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 426c049d4f..b7b234dd0f 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -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 -- GitLab