Commit e3a3b01b authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Fix build-tools ordering regression (#3257, #1541)



When converting the component graph to operate in terms of UnitIds
instead of CNames I accidentally introduced a regression where we
stopped respecting build-tools when determining an ordering to
build things.  This commit fixes the regression (though perhaps
not in the most clean/performant way you could manage it.)  It
also fixes a latent bug if internal libraries aren't processed
in the correct order.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 7440d888
......@@ -95,6 +95,10 @@ extra-source-files:
tests/PackageTests/CopyComponent/Lib/Main.hs
tests/PackageTests/CopyComponent/Lib/p.cabal
tests/PackageTests/CopyComponent/Lib/src/P.hs
tests/PackageTests/CustomPreProcess/Hello.hs
tests/PackageTests/CustomPreProcess/MyCustomPreprocessor.hs
tests/PackageTests/CustomPreProcess/Setup.hs
tests/PackageTests/CustomPreProcess/internal-preprocessor-test.cabal
tests/PackageTests/DeterministicAr/Lib.hs
tests/PackageTests/DeterministicAr/my.cabal
tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal
......
......@@ -127,6 +127,8 @@ import Text.PrettyPrint
import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO )
import Data.Graph (graphFromEdges, topSort)
-- | The errors that can be thrown when reading the @setup-config@ file.
data ConfigStateFileError
= ConfigStateFileNoHeader -- ^ No header found.
......@@ -1436,7 +1438,7 @@ mkComponentsGraph pkg_descr internalPkgDeps =
| c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ]
Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]
Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- topSortFromEdges graph ]
where
-- The dependencies for the given component
componentDeps component =
......@@ -1620,6 +1622,12 @@ computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str
| otherwise = str
topSortFromEdges :: Ord key => [(node, key, [key])]
-> [(node, key, [key])]
topSortFromEdges es =
let (graph, vertexToNode, _) = graphFromEdges es
in reverse (map vertexToNode (topSort graph))
mkComponentsLocalBuildInfo :: ConfigFlags
-> Compiler
-> InstalledPackageIndex
......@@ -1635,14 +1643,15 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
graph flagAssignment =
foldM go [] graph
where
go :: [(ComponentLocalBuildInfo, [UnitId])]
-> (Component, [ComponentName])
-> IO [(ComponentLocalBuildInfo, [UnitId])]
go z (component, _) = do
go z (component, dep_cnames) = do
clbi <- componentLocalBuildInfo z component
-- TODO: Maybe just store the internal deps in the clbi?
let dep_uids = map fst (filter (\(_,e) -> e `elem` internalPkgDeps)
(componentPackageDeps clbi))
-- NB: We want to preserve cdeps because it contains extra
-- information like build-tools ordering
let dep_uids = [ componentUnitId dep_clbi
| cname <- dep_cnames
-- Being in z relies on topsort!
, (dep_clbi, _) <- z
, componentLocalName dep_clbi == cname ]
return ((clbi, dep_uids):z)
-- The allPkgDeps contains all the package deps for the whole package
......
module A where
a :: String
a = "hello from A"
module Main where
import A
main :: IO ()
main = putStrLn a
module Main where
import System.Directory
import System.Environment
main :: IO ()
main = do
(source:target:_) <- getArgs
copyFile source target
{-# OPTIONS_GHC -Wall #-}
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.Simple.Utils
import System.Exit
import System.FilePath
import System.Process (rawSystem)
main :: IO ()
main = defaultMainWithHooks
simpleUserHooks { hookedPreProcessors = [("pre", myCustomPreprocessor)] }
where
myCustomPreprocessor :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
myCustomPreprocessor _bi lbi _clbi =
PreProcessor {
platformIndependent = True,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
do info verbosity ("Preprocessing " ++ inFile ++ " to " ++ outFile)
callProcess progPath [inFile, outFile]
}
where
builddir = buildDir lbi
progName = "my-custom-preprocessor"
progPath = builddir </> progName </> progName
-- Backwards compat with process < 1.2.
callProcess :: FilePath -> [String] -> IO ()
callProcess path args =
do exitCode <- rawSystem path args
case exitCode of ExitSuccess -> return ()
f@(ExitFailure _) -> fail $ "callProcess " ++ show path
++ " " ++ show args ++ " failed: "
++ show f
name: internal-preprocessor-test
version: 0.1.0.0
synopsis: Internal custom preprocessor example.
description: See https://github.com/haskell/cabal/issues/1541#issuecomment-30155513
license: GPL-3
author: Mikhail Glushenkov
maintainer: mikhail.glushenkov@gmail.com
category: Testing
build-type: Custom
cabal-version: >=1.10
-- Note that exe comes before the library.
-- The reason is backwards compat: old versions of Cabal (< 1.18)
-- don't have a proper component build graph, so components are
-- built in declaration order.
executable my-custom-preprocessor
main-is: MyCustomPreprocessor.hs
build-depends: base, directory
default-language: Haskell2010
library
exposed-modules: A
build-depends: base
build-tools: my-custom-preprocessor
-- ^ Note the internal dependency.
default-language: Haskell2010
executable hello-world
main-is: Hello.hs
build-depends: base, internal-preprocessor-test
default-language: Haskell2010
......@@ -453,8 +453,7 @@ rawCompileSetup verbosity suite e path = do
r <- rawRun verbosity (Just path) (ghcPath suite) e $
[ "--make"] ++
ghcPackageDBParams (ghcVersion suite) (packageDBStack suite) ++
[ "-hide-all-packages"
, "-package base"
[ "-hide-package Cabal"
#ifdef LOCAL_COMPONENT_ID
-- This is best, but we don't necessarily have it
-- if we're bootstrapping with old Cabal.
......
......@@ -338,6 +338,12 @@ tests config = do
cabal "build" ["myprog"]
cabal "copy" ["myprog"]
-- Test internal custom preprocessor
tc "CustomPreProcess" $ do
cabal_build []
runExe' "hello-world" []
>>= assertOutputContains "hello from A"
where
ghc_pkg_guess bin_name = do
cwd <- packageDir
......
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