[commit: ghc] master: hadrian: build ghc-iserv-prof in addition to ghc-iserv (695f1f2)

git at git.haskell.org git at git.haskell.org
Fri Nov 2 00:34:23 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/695f1f2fe03d71bad47d52f003881b34eb5083b4/ghc

>---------------------------------------------------------------

commit 695f1f2fe03d71bad47d52f003881b34eb5083b4
Author: Alp Mestanogullari <alp at well-typed.com>
Date:   Thu Nov 1 18:31:46 2018 -0400

    hadrian: build ghc-iserv-prof in addition to ghc-iserv
    
    As it is required for 10+ tests.
    
    Hadrian didn't give us a chance to build a given executable in vanilla
    and profiling, simultaneously, under two different names. This patch
    implements support for this in general and applies it to
    ghc-iserv[-prof].
    
    Test Plan: scc001 fails without this patch, passes with it.
    
    Reviewers: snowleopard, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: simonpj, ndmitchell, simonmar, rwbarton, carter
    
    Differential Revision: https://phabricator.haskell.org/D5255


>---------------------------------------------------------------

695f1f2fe03d71bad47d52f003881b34eb5083b4
 hadrian/src/Packages.hs      | 16 ++++++++++++----
 hadrian/src/Rules/Program.hs | 21 +++++++++++++++------
 hadrian/src/Rules/Test.hs    | 11 ++++++-----
 3 files changed, 33 insertions(+), 15 deletions(-)

diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index 8a9a48f..4ce1a2c 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -132,10 +132,17 @@ programName Context {..} = do
     targetPlatform <- setting TargetPlatformFull
     let prefix = if cross then targetPlatform ++ "-" else ""
     -- TODO: Can we extract this information from Cabal files?
+    -- Alp: We could, but then the iserv package would have to
+    --      use Cabal conditionals + a 'profiling' flag
+    --      to declare the executable name, and I'm not sure
+    --      this is allowed (or desired for that matter).
     return $ prefix ++ case package of
                               p | p == ghc    -> "ghc"
                                 | p == hpcBin -> "hpc"
-                                | p == iserv  -> "ghc-iserv"
+                                | p == iserv  ->
+                                    if Profiling `wayUnit` way
+                                      then "ghc-iserv-prof"
+                                      else "ghc-iserv"
                               _               -> pkgName package
 
 -- | The 'FilePath' to a program executable in a given 'Context'.
@@ -144,10 +151,11 @@ programPath context at Context {..} = do
     -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of
     -- @bin@, which is likely just a historical accident that should be fixed.
     -- See: https://github.com/snowleopard/hadrian/issues/570
-    -- Likewise for 'unlit'.
+    -- Likewise for @iserv@ and @unlit at .
     name <- programName context
-    path <- if package `elem` [touchy, unlit] then stageLibPath stage <&> (-/- "bin")
-                                              else stageBinPath stage
+    path <- if package `elem` [iserv, touchy, unlit]
+              then stageLibPath stage <&> (-/- "bin")
+              else stageBinPath stage
     return $ path -/- name <.> exe
 
 -- TODO: Move @timeout@ to the @util@ directory and build in a more standard
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index f5be21a..7128a75 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -28,14 +28,23 @@ buildProgram rs = do
             -- 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)
+            nameToCtxList <- fmap concat . forM allPackages $ \pkg -> do
+                -- the iserv pkg results in two different programs at
+                -- the moment, ghc-iserv (built the vanilla way)
+                -- and ghc-iserv-prof (built the profiling way), and
+                -- the testsuite requires both to be present, so we
+                -- make sure that we cover these
+                -- "prof-build-under-other-name" cases.
+                -- iserv gets its two names from Packages.hs:programName
+                let ctxV = vanillaContext stage pkg
+                    ctxProf = Context stage pkg profiling
+                nameV <- programName ctxV
+                nameProf <- programName ctxProf
+                return [ (nameV <.> exe, ctxV), (nameProf <.> exe, ctxProf) ]
 
             case lookup (takeFileName bin) nameToCtxList of
                 Nothing -> error $ "Unknown program " ++ show bin
-                Just (Context {..}) -> do
+                Just ctx@(Context {..}) -> do
                     -- Custom dependencies: this should be modeled better in the
                     -- Cabal file somehow.
                     -- TODO: Is this still needed? See 'runtimeDependencies'.
@@ -58,7 +67,7 @@ buildProgram rs = do
                         (False, s) | s > Stage0 && (package `elem` [touchy, unlit]) -> do
                             srcDir <- stageLibPath Stage0 <&> (-/- "bin")
                             copyFile (srcDir -/- takeFileName bin) bin
-                        _ -> buildBinary rs bin =<< programContext stage package
+                        _ -> buildBinary rs bin ctx
 
 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
 buildBinary rs bin context at Context {..} = do
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index f5d6990..6a02ce6 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -81,12 +81,8 @@ testRules = do
 needTestsuitePackages :: Action ()
 needTestsuitePackages = do
     targets   <- mapM (needFile Stage1) =<< testsuitePackages
-    libPath   <- stageLibPath Stage1
-    iservPath <- needFile Stage1 iserv
+    needIservBins
     need targets
-    -- | We need to copy iserv bin to lib/bin as this is where testsuite looks
-    -- | for iserv.
-    copyFile iservPath $ libPath -/- "bin/ghc-iserv"
 
 -- | Build the timeout program.
 -- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
@@ -107,6 +103,11 @@ timeoutProgBuilder = do
             writeFile' (root -/- timeoutPath) script
             makeExecutable (root -/- timeoutPath)
 
+needIservBins :: Action ()
+needIservBins =
+    need =<< traverse programPath
+      [ Context Stage1 iserv w | w <- [vanilla, profiling] ]
+
 needTestBuilders :: Action ()
 needTestBuilders = do
     needBuilder $ Ghc CompileHs Stage2



More information about the ghc-commits mailing list