Skip to content

Commit

Permalink
Fix build-tools ordering regression (#3257, #1541)
Browse files Browse the repository at this point in the history
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: Edward Z. Yang <[email protected]>
  • Loading branch information
ezyang committed Apr 1, 2016
1 parent 7440d88 commit e3a3b01
Show file tree
Hide file tree
Showing 9 changed files with 114 additions and 10 deletions.
4 changes: 4 additions & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
25 changes: 17 additions & 8 deletions Cabal/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 4 additions & 0 deletions Cabal/tests/PackageTests/CustomPreProcess/A.pre
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
module A where

a :: String
a = "hello from A"
6 changes: 6 additions & 0 deletions Cabal/tests/PackageTests/CustomPreProcess/Hello.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
module Main where

import A

main :: IO ()
main = putStrLn a
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
module Main where

import System.Directory
import System.Environment

main :: IO ()
main = do
(source:target:_) <- getArgs
copyFile source target
36 changes: 36 additions & 0 deletions Cabal/tests/PackageTests/CustomPreProcess/Setup.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
{-# 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
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
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: [email protected]
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
3 changes: 1 addition & 2 deletions Cabal/tests/PackageTests/PackageTester.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
6 changes: 6 additions & 0 deletions Cabal/tests/PackageTests/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit e3a3b01

Please sign in to comment.