Add checkPpr package and infrastructure for testsuite packages (#596)
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 11 May 2018 22:28:56 +0000 (00:28 +0200)
committerGitHub <noreply@github.com>
Fri, 11 May 2018 22:28:56 +0000 (00:28 +0200)
See #593

src/GHC.hs
src/GHC/Packages.hs
src/Rules.hs
src/Rules/Program.hs
src/Rules/Test.hs

index 5c690dd..61bfb7f 100644 (file)
@@ -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
index 68c93ec..79830dc 100644 (file)
@@ -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)
index 1ecb476..7533a27 100644 (file)
@@ -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'.
index 67a310f..aebaaab 100644 (file)
@@ -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
index 426c049..b7b234d 100644 (file)
@@ -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