Commit 2978ef8b authored by ttuegel's avatar ttuegel

Handle test and benchmark dependencies through the resolver properly.

Previously, test and benchmark dependencies were handled by editing the
package description to include or exclude those stanzas before running
the dependency resolver. Test and benchmark dependencies could only be
installed for source packages because no package description is available
for named packages before dependency resolution.

Now, test and benchmark stanzas are enabled or disabled through constraints
passed to the dependency resolver. This way, we can install dependencies for
the test suites of target packages without propagating '--enable-tests'
through the entire dependency tree; i.e., tests and benchmarks, when enabled,
are built only for target packages. Later, this will allow us to
automatically run test suites and, e.g., install only upon their success.
parent f0e4ca2a
......@@ -122,7 +122,7 @@ data Outcome = NotTried | Failed | Ok
new :: OS -> Arch -> CompilerId -- -> Version
-> ConfiguredPackage -> BR.BuildResult
-> BuildReport
new os' arch' comp (ConfiguredPackage pkg flags deps) result =
new os' arch' comp (ConfiguredPackage pkg flags _ deps) result =
BuildReport {
package = packageId pkg,
os = os',
......
......@@ -117,11 +117,11 @@ fromPlanPackage :: Platform -> CompilerId
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
InstallPlan.Installed pkg@(ConfiguredPackage (SourcePackage {
packageSource = RepoTarballPackage repo _ _ }) _ _) result
packageSource = RepoTarballPackage repo _ _ }) _ _ _) result
-> Just $ (BuildReport.new os arch comp pkg (Right result), repo)
InstallPlan.Failed pkg@(ConfiguredPackage (SourcePackage {
packageSource = RepoTarballPackage repo _ _ }) _ _) result
packageSource = RepoTarballPackage repo _ _ }) _ _ _) result
-> Just $ (BuildReport.new os arch comp pkg (Left result), repo)
_ -> Nothing
......@@ -82,7 +82,7 @@ configure verbosity packageDBs repos comp conf
configureCommand (const configFlags) extraArgs
Right installPlan -> case InstallPlan.ready installPlan of
[pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _)] ->
[pkg@(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _)) _ _ _)] ->
configurePackage verbosity
(InstallPlan.planPlatform installPlan)
(InstallPlan.planCompiler installPlan)
......@@ -177,7 +177,7 @@ configurePackage :: Verbosity
-> [String]
-> IO ()
configurePackage verbosity platform comp scriptOptions configFlags
(ConfiguredPackage (SourcePackage _ gpkg _) flags deps) extraArgs =
(ConfiguredPackage (SourcePackage _ gpkg _) flags stanzas deps) extraArgs =
setupWrapper verbosity
scriptOptions (Just pkg) configureCommand configureFlags extraArgs
......@@ -186,11 +186,13 @@ configurePackage verbosity platform comp scriptOptions configFlags
configureFlags = filterConfigureFlags configFlags {
configConfigurationsFlags = flags,
configConstraints = map thisPackageVersion deps,
configVerbosity = toFlag verbosity
configVerbosity = toFlag verbosity,
configBenchmarks = toFlag (BenchStanzas `elem` stanzas),
configTests = toFlag (TestStanzas `elem` stanzas)
}
pkg = case finalizePackageDescription flags
(const True)
platform comp [] gpkg of
platform comp [] (enableStanzas stanzas gpkg) of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc
......@@ -24,7 +24,8 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan
( PlanPackage(..) )
import Distribution.Client.Types
( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..) )
( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..)
, enableStanzas )
import Distribution.Client.Dependency.Types
( DependencyResolver, PackageConstraint(..)
, PackagePreferences(..), InstalledPreference(..)
......@@ -108,8 +109,8 @@ explore pref (ChoiceNode _ choices) =
where
topSortNumber choice = case fst (head choice) of
InstalledOnly (InstalledPackageEx _ i _) -> i
SourceOnly (UnconfiguredPackage _ i _) -> i
InstalledAndSource _ (UnconfiguredPackage _ i _) -> i
SourceOnly (UnconfiguredPackage _ i _ _) -> i
InstalledAndSource _ (UnconfiguredPackage _ i _ _) -> i
bestByPref pkgname = case packageInstalledPreference of
PreferLatest ->
......@@ -197,7 +198,7 @@ packageConstraints = either installedConstraints availableConstraints
installedConstraints (InstalledPackageEx _ _ deps) =
[ (thisPackageVersion dep, True)
| dep <- deps ]
availableConstraints (SemiConfiguredPackage _ _ deps) =
availableConstraints (SemiConfiguredPackage _ _ _ deps) =
[ (dep, False) | dep <- deps ]
addDeps :: Constraints -> [PackageName] -> Constraints
......@@ -339,6 +340,9 @@ addTopLevelConstraints (PackageConstraintSource pkg:deps) cs =
ConflictsWith conflicts ->
Fail (TopLevelInstallConstraintConflict pkg SourceConstraint conflicts)
addTopLevelConstraints (PackageConstraintStanzas _ _ : deps) cs =
addTopLevelConstraints deps cs
-- | Add exclusion on available packages that cannot be configured.
--
pruneBottomUp :: Platform -> CompilerId
......@@ -364,9 +368,9 @@ pruneBottomUp platform comp constraints =
[ (dep, Constraints.conflicting cs dep)
| dep <- missing ]
configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags) =
configure cs (UnconfiguredPackage (SourcePackage _ pkg _) _ flags stanzas) =
finalizePackageDescription flags (dependencySatisfiable cs)
platform comp [] pkg
platform comp [] (enableStanzas stanzas pkg)
dependencySatisfiable cs =
not . null . PackageIndex.lookupDependency (Constraints.choices cs)
......@@ -378,8 +382,8 @@ pruneBottomUp platform comp constraints =
. Constraints.choices
topSortNumber (InstalledOnly (InstalledPackageEx _ i _)) = i
topSortNumber (SourceOnly (UnconfiguredPackage _ i _)) = i
topSortNumber (InstalledAndSource _ (UnconfiguredPackage _ i _)) = i
topSortNumber (SourceOnly (UnconfiguredPackage _ i _ _)) = i
topSortNumber (InstalledAndSource _ (UnconfiguredPackage _ i _ _)) = i
getSourcePkg (InstalledOnly _ ) = Nothing
getSourcePkg (SourceOnly spkg) = Just spkg
......@@ -393,12 +397,12 @@ configurePackage platform comp available spkg = case spkg of
InstalledAndSource ipkg apkg -> fmap (InstalledAndSource ipkg)
(configure apkg)
where
configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags) =
configure (UnconfiguredPackage apkg@(SourcePackage _ p _) _ flags stanzas) =
case finalizePackageDescription flags dependencySatisfiable
platform comp [] p of
platform comp [] (enableStanzas stanzas p) of
Left missing -> Left missing
Right (pkg, flags') -> Right $
SemiConfiguredPackage apkg flags' (externalBuildDepends pkg)
SemiConfiguredPackage apkg flags' stanzas (externalBuildDepends pkg)
dependencySatisfiable = not . null . PackageIndex.lookupDependency available
......@@ -427,7 +431,7 @@ annotateSourcePackages :: [PackageConstraint]
-> PackageIndex UnconfiguredPackage
annotateSourcePackages constraints dfsNumber sourcePkgIndex =
PackageIndex.fromList
[ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name)
[ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name) (stanzasFor name)
| pkg <- PackageIndex.allPackages sourcePkgIndex
, let name = packageName pkg ]
where
......@@ -435,6 +439,10 @@ annotateSourcePackages constraints dfsNumber sourcePkgIndex =
flagsMap = Map.fromList
[ (name, flags)
| PackageConstraintFlags name flags <- constraints ]
stanzasFor = fromMaybe [] . flip Map.lookup stanzasMap
stanzasMap = Map.fromList
[ (name, stanzas)
| PackageConstraintStanzas name stanzas <- constraints ]
-- | One of the heuristics we use when guessing which path to take in the
-- search space is an ordering on the choices we make. It's generally better
......@@ -546,8 +554,8 @@ finaliseSelectedPackages pref selected constraints =
Just (InstalledAndSource _ _) -> finaliseSource (Just ipkg) apkg
finaliseInstalled (InstalledPackageEx pkg _ _) = InstallPlan.PreExisting pkg
finaliseSource mipkg (SemiConfiguredPackage pkg flags deps) =
InstallPlan.Configured (ConfiguredPackage pkg flags deps')
finaliseSource mipkg (SemiConfiguredPackage pkg flags stanzas deps) =
InstallPlan.Configured (ConfiguredPackage pkg flags stanzas deps')
where
deps' = map (packageId . pickRemaining mipkg) deps
......
......@@ -13,7 +13,7 @@
module Distribution.Client.Dependency.TopDown.Types where
import Distribution.Client.Types
( SourcePackage(..), InstalledPackage )
( SourcePackage(..), InstalledPackage, OptionalStanza )
import Distribution.Package
( PackageIdentifier, Dependency
......@@ -50,11 +50,13 @@ data UnconfiguredPackage
SourcePackage
!TopologicalSortNumber
FlagAssignment
[OptionalStanza]
data SemiConfiguredPackage
= SemiConfiguredPackage
SourcePackage -- package info
FlagAssignment -- total flag assignment for the package
[OptionalStanza] -- enabled optional stanzas
[Dependency] -- dependencies we end up with when we apply
-- the flag assignment
......@@ -65,10 +67,10 @@ instance PackageFixedDeps InstalledPackageEx where
depends (InstalledPackageEx _ _ deps) = deps
instance Package UnconfiguredPackage where
packageId (UnconfiguredPackage p _ _) = packageId p
packageId (UnconfiguredPackage p _ _ _) = packageId p
instance Package SemiConfiguredPackage where
packageId (SemiConfiguredPackage p _ _) = packageId p
packageId (SemiConfiguredPackage p _ _ _) = packageId p
instance (Package installed, Package source)
=> Package (InstalledOrSource installed source) where
......
......@@ -34,7 +34,7 @@ import Data.Monoid
( Monoid(..) )
import Distribution.Client.Types
( SourcePackage(..) )
( OptionalStanza, SourcePackage(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Compat.ReadP
......@@ -116,6 +116,7 @@ data PackageConstraint
| PackageConstraintInstalled PackageName
| PackageConstraintSource PackageName
| PackageConstraintFlags PackageName FlagAssignment
| PackageConstraintStanzas PackageName [OptionalStanza]
deriving (Show,Eq)
-- | A per-package preference on the version. It is a soft constraint that the
......
......@@ -131,7 +131,7 @@ planPackages verbosity comp fetchFlags
-- that are in the 'InstallPlan.Configured' state.
return
[ pkg
| (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _))
| (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _ _))
<- InstallPlan.toList installPlan ]
| otherwise =
......
......@@ -103,10 +103,10 @@ import Distribution.Package
, Dependency(..), thisPackageVersion )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( Benchmark(..), PackageDescription, GenericPackageDescription(..)
, TestSuite(..), Flag(..), FlagName(..), FlagAssignment )
( PackageDescription, GenericPackageDescription(..), Flag(..)
, FlagName(..), FlagAssignment )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
( finalizePackageDescription )
import Distribution.Version
( Version, anyVersion, thisVersion )
import Distribution.Simple.Utils as Utils
......@@ -266,36 +266,22 @@ planPackages comp configFlags configExFlags installFlags
[ PackageConstraintFlags (pkgSpecifierTarget pkgSpecifier) flags
| let flags = configConfigurationsFlags configFlags
, not (null flags)
, pkgSpecifier <- pkgSpecifiers'' ]
, pkgSpecifier <- pkgSpecifiers ]
. addConstraints
[ PackageConstraintStanzas (pkgSpecifierTarget pkgSpecifier) stanzas
| pkgSpecifier <- pkgSpecifiers ]
. (if reinstall then reinstallTargets else id)
$ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers''
$ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
-- Mark test suites as enabled if invoked with '--enable-tests'. This
-- ensures that test suite dependencies are included.
pkgSpecifiers' = map enableTests pkgSpecifiers
stanzas = concat
[ if testsEnabled then [TestStanzas] else []
, if benchmarksEnabled then [BenchStanzas] else []
]
testsEnabled = fromFlagOrDefault False $ configTests configFlags
enableTests (SpecificSourcePackage pkg) =
let pkgDescr = Source.packageDescription pkg
suites = condTestSuites pkgDescr
enable = mapTreeData (\t -> t { testEnabled = testsEnabled })
in SpecificSourcePackage $ pkg { Source.packageDescription = pkgDescr
{ condTestSuites = map (\(n, t) -> (n, enable t)) suites } }
enableTests x = x
-- Mark benchmarks as enabled if invoked with
-- '--enable-benchmarks'. This ensures that benchmark dependencies
-- are included.
pkgSpecifiers'' = map enableBenchmarks pkgSpecifiers'
benchmarksEnabled = fromFlagOrDefault False $ configBenchmarks configFlags
enableBenchmarks (SpecificSourcePackage pkg) =
let pkgDescr = Source.packageDescription pkg
bms = condBenchmarks pkgDescr
enable = mapTreeData (\t -> t { benchmarkEnabled = benchmarksEnabled })
in SpecificSourcePackage $ pkg { Source.packageDescription = pkgDescr
{ condBenchmarks = map (\(n, t) -> (n, enable t)) bms } }
enableBenchmarks x = x
--TODO: this is a general feature and should be moved to D.C.Dependency
-- Also, the InstallPlan.remove should return info more precise to the
......@@ -456,7 +442,7 @@ printDryRun verbosity plan = case plan of
toFlagAssignment = map (\ f -> (flagName f, flagDefault f))
nonDefaultFlags :: ConfiguredPackage -> FlagAssignment
nonDefaultFlags (ConfiguredPackage spkg fa _) =
nonDefaultFlags (ConfiguredPackage spkg fa _ _) =
let defaultAssignment =
toFlagAssignment
(genPackageFlags (Source.packageDescription spkg))
......@@ -782,15 +768,17 @@ installConfiguredPackage :: Platform -> CompilerId
-> PackageDescription -> a)
-> a
installConfiguredPackage platform comp configFlags
(ConfiguredPackage (SourcePackage _ gpkg source) flags deps)
(ConfiguredPackage (SourcePackage _ gpkg source) flags stanzas deps)
installPkg = installPkg configFlags {
configConfigurationsFlags = flags,
configConstraints = map thisPackageVersion deps
configConstraints = map thisPackageVersion deps,
configBenchmarks = toFlag (BenchStanzas `elem` stanzas),
configTests = toFlag (TestStanzas `elem` stanzas)
} source pkg
where
pkg = case finalizePackageDescription flags
(const True)
platform comp [] gpkg of
platform comp [] (enableStanzas stanzas gpkg) of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc
......
......@@ -46,8 +46,7 @@ module Distribution.Client.InstallPlan (
import Distribution.Client.Types
( SourcePackage(packageDescription), ConfiguredPackage(..)
, InstalledPackage
, BuildFailure, BuildSuccess )
, InstalledPackage, BuildFailure, BuildSuccess, enableStanzas )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
, PackageFixedDeps(..), Dependency(..) )
......@@ -472,7 +471,7 @@ showPackageProblem (InvalidDep dep pkgid) =
configuredPackageProblems :: Platform -> CompilerId
-> ConfiguredPackage -> [PackageProblem]
configuredPackageProblems platform comp
(ConfiguredPackage pkg specifiedFlags specifiedDeps) =
(ConfiguredPackage pkg specifiedFlags stanzas specifiedDeps) =
[ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
......@@ -506,6 +505,6 @@ configuredPackageProblems platform comp
(const True)
platform comp
[]
(packageDescription pkg) of
(enableStanzas stanzas $ packageDescription pkg) of
Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg
Left _ -> error "configuredPackageInvalidDeps internal error"
......@@ -40,7 +40,7 @@ symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"
#else
import Distribution.Client.Types
( SourcePackage(..), ConfiguredPackage(..) )
( SourcePackage(..), ConfiguredPackage(..), enableStanzas )
import Distribution.Client.Setup
( InstallFlags(installSymlinkBinDir) )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -132,10 +132,10 @@ symlinkBinaries configFlags installFlags plan =
, PackageDescription.buildable (PackageDescription.buildInfo exe) ]
pkgDescription :: ConfiguredPackage -> PackageDescription
pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags _) =
pkgDescription (ConfiguredPackage (SourcePackage _ pkg _) flags stanzas _) =
case finalizePackageDescription flags
(const True)
platform compilerId [] pkg of
platform compilerId [] (enableStanzas stanzas pkg) of
Left _ -> error "finalizePackageDescription ConfiguredPackage failed"
Right (desc, _) -> desc
......
......@@ -690,6 +690,7 @@ renamePackageConstraint name pc = case pc of
PackageConstraintInstalled _ -> PackageConstraintInstalled name
PackageConstraintSource _ -> PackageConstraintSource name
PackageConstraintFlags _ flags -> PackageConstraintFlags name flags
PackageConstraintStanzas _ stanzas -> PackageConstraintStanzas name stanzas
readUserConstraint :: String -> Either String UserConstraint
readUserConstraint str =
......
......@@ -19,6 +19,8 @@ import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.PackageDescription
( GenericPackageDescription, FlagAssignment )
import Distribution.PackageDescription.Configuration
( enableBenchmarks, enableTests )
import Distribution.Client.PackageIndex
( PackageIndex )
import Distribution.Version
......@@ -74,17 +76,18 @@ instance PackageFixedDeps InstalledPackage where
data ConfiguredPackage = ConfiguredPackage
SourcePackage -- package info, including repo
FlagAssignment -- complete flag assignment for the package
[OptionalStanza] -- list of enabled optional stanzas for the package
[PackageId] -- set of exact dependencies. These must be
-- consistent with the 'buildDepends' in the
-- 'PackageDescription' that you'd get by applying
-- the flag assignment.
-- the flag assignment and optional stanzas.
deriving Show
instance Package ConfiguredPackage where
packageId (ConfiguredPackage pkg _ _) = packageId pkg
packageId (ConfiguredPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ConfiguredPackage where
depends (ConfiguredPackage _ _ deps) = deps
depends (ConfiguredPackage _ _ _ deps) = deps
-- | A package description along with the location of the package sources.
......@@ -98,6 +101,19 @@ data SourcePackage = SourcePackage {
instance Package SourcePackage where packageId = packageInfoId
data OptionalStanza
= TestStanzas
| BenchStanzas
deriving (Eq, Show)
enableStanzas
:: [OptionalStanza]
-> GenericPackageDescription
-> GenericPackageDescription
enableStanzas stanzas
= enableTests (TestStanzas `elem` stanzas)
. enableBenchmarks (BenchStanzas `elem` stanzas)
-- ------------------------------------------------------------
-- * Package locations and repositories
-- ------------------------------------------------------------
......
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