Commit 1bc42a89 authored by kristenk's avatar kristenk Committed by Mikhail Glushenkov

Solver DSL: Support benchmarks, internal libraries, and foreign libraries.

This change allows the solver quickcheck tests to test all types of components.
Previously, the tests generated the components in the solver DSL, but the code
that converted the packages to GenericPackageDescriptions removed some of the
components, i.e., it filtered out benchmarks and foreign libraries and merged
internal libraries with the main library.
parent 3c339d2e
......@@ -40,6 +40,7 @@ import Prelude ()
import Distribution.Solver.Compat.Prelude
-- base
import Control.Arrow (second)
import Data.Either (partitionEithers)
import qualified Data.Map as Map
......@@ -50,7 +51,8 @@ import Distribution.License (License(..))
import qualified Distribution.ModuleName as Module
import qualified Distribution.Package as C
hiding (HasUnitId(..))
import qualified Distribution.Types.ExeDependency as C
import qualified Distribution.Types.ExeDependency as C
import qualified Distribution.Types.ForeignLib as C
import qualified Distribution.Types.LegacyExeDependency as C
import qualified Distribution.Types.PkgconfigDependency as C
import qualified Distribution.Types.UnqualComponentName as C
......@@ -327,14 +329,14 @@ exAvSrcPkg ex =
usedFlags :: Map ExampleFlagName C.Flag
usedFlags = Map.fromList [(fn, mkDefaultFlag fn) | fn <- names]
where
names = concatMap extractFlags $
CD.libraryDeps (exAvDeps ex)
++ concatMap snd testSuites
++ concatMap snd executables
names = concatMap extractFlags $ CD.flatDeps (exAvDeps ex)
in -- 'declaredFlags' overrides 'usedFlags' to give flags non-default settings:
Map.elems $ declaredFlags `Map.union` usedFlags
subLibraries = [(name, deps) | (CD.ComponentSubLib name, deps) <- CD.toList (exAvDeps ex)]
foreignLibraries = [(name, deps) | (CD.ComponentFLib name, deps) <- CD.toList (exAvDeps ex)]
testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)]
benchmarks = [(name, deps) | (CD.ComponentBench name, deps) <- CD.toList (exAvDeps ex)]
executables = [(name, deps) | (CD.ComponentExe name, deps) <- CD.toList (exAvDeps ex)]
setup = case CD.setupDeps (exAvDeps ex) of
[] -> Nothing
......@@ -359,24 +361,35 @@ exAvSrcPkg ex =
, C.description = "description"
, C.synopsis = "synopsis"
, C.licenseFiles = ["LICENSE"]
, C.specVersionRaw = Left $ C.mkVersion [1,12]
-- Version 2.0 is required for internal libraries.
, C.specVersionRaw = Left $ C.mkVersion [2,0]
}
, C.genPackageFlags = flags
, C.condLibrary =
let mkLib bi = mempty { C.libBuildInfo = bi }
in Just $ mkCondTree defaultLib mkLib $ mkBuildInfoTree $
Buildable (CD.libraryDeps (exAvDeps ex))
, C.condSubLibraries = []
, C.condForeignLibs = []
Buildable $ fromMaybe [] $
lookup CD.ComponentLib (CD.toList (exAvDeps ex))
, C.condSubLibraries =
let mkTree = mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable
mkLib bi = mempty { C.libBuildInfo = bi }
in map (second mkTree) subLibraries
, C.condForeignLibs =
let mkTree = mkCondTree mempty mkLib . mkBuildInfoTree . Buildable
mkLib bi = mempty { C.foreignLibBuildInfo = bi }
in map (second mkTree) foreignLibraries
, C.condExecutables =
let mkTree = mkCondTree defaultExe mkExe . mkBuildInfoTree . Buildable
mkExe bi = mempty { C.buildInfo = bi }
in map (\(t, deps) -> (t, mkTree deps)) executables
in map (second mkTree) executables
, C.condTestSuites =
let mkTree = mkCondTree defaultTest mkTest . mkBuildInfoTree . Buildable
mkTest bi = mempty { C.testBuildInfo = bi }
in map (\(t, deps) -> (t, mkTree deps)) testSuites
, C.condBenchmarks = []
in map (second mkTree) testSuites
, C.condBenchmarks =
let mkTree = mkCondTree defaultBenchmark mkBench . mkBuildInfoTree . Buildable
mkBench bi = mempty { C.benchmarkBuildInfo = bi }
in map (second mkTree) benchmarks
}
}
pkgCheckErrors =
......@@ -405,6 +418,11 @@ exAvSrcPkg ex =
C.testInterface = C.TestSuiteExeV10 (C.mkVersion [1,0]) "Test.hs"
}
defaultBenchmark :: C.Benchmark
defaultBenchmark = mempty {
C.benchmarkInterface = C.BenchmarkExeV10 (C.mkVersion [1,0]) "Benchmark.hs"
}
-- Split the set of dependencies into the set of dependencies of the library,
-- the dependencies of the test suites and extensions.
splitTopLevel :: [ExampleDependency]
......
......@@ -267,7 +267,7 @@ instance Arbitrary TestDb where
arbitraryExAv :: PN -> PV -> TestDb -> Gen ExampleAvailable
arbitraryExAv pn v db =
(\cds -> ExAv (unPN pn) (unPV v) cds []) <$> arbitraryComponentDeps db
(\cds -> ExAv (unPN pn) (unPV v) cds []) <$> arbitraryComponentDeps pn db
arbitraryExInst :: PN -> PV -> [ExampleInstalled] -> Gen ExampleInstalled
arbitraryExInst pn v pkgs = do
......@@ -276,15 +276,19 @@ arbitraryExInst pn v pkgs = do
deps <- randomSubset numDeps pkgs
return $ ExInst (unPN pn) (unPV v) pkgHash (map exInstHash deps)
arbitraryComponentDeps :: TestDb -> Gen (ComponentDeps [ExampleDependency])
arbitraryComponentDeps (TestDb []) = return $ CD.fromList []
arbitraryComponentDeps db =
-- dedupComponentNames removes components with duplicate names, for example,
-- 'ComponentExe x' and 'ComponentTest x', and then CD.fromList combines
-- duplicate unnamed components.
CD.fromList . dedupComponentNames <$>
boundedListOf 5 (arbitraryComponentDep db)
arbitraryComponentDeps :: PN -> TestDb -> Gen (ComponentDeps [ExampleDependency])
arbitraryComponentDeps _ (TestDb []) = return $ CD.fromList []
arbitraryComponentDeps pn db =
-- dedupComponentNames removes components with duplicate names, for example,
-- 'ComponentExe x' and 'ComponentTest x', and then CD.fromList combines
-- duplicate unnamed components.
CD.fromList . dedupComponentNames . filter (isValid . fst)
<$> boundedListOf 5 (arbitraryComponentDep db)
where
isValid :: Component -> Bool
isValid (ComponentSubLib name) = name /= mkUnqualComponentName (unPN pn)
isValid _ = True
dedupComponentNames =
nubBy ((\x y -> isJust x && isJust y && x == y) `on` componentName . fst)
......@@ -378,7 +382,12 @@ instance Arbitrary IndependentGoals where
shrink (IndependentGoals indep) = [IndependentGoals False | indep]
instance Arbitrary UnqualComponentName where
arbitrary = mkUnqualComponentName <$> (:[]) <$> elements "ABC"
-- The "component-" prefix prevents component names and build-depends
-- dependency names from overlapping.
-- TODO: Remove the prefix once the QuickCheck tests support dependencies on
-- internal libraries.
arbitrary =
mkUnqualComponentName <$> (\c -> "component-" ++ [c]) <$> elements "ABC"
instance Arbitrary Component where
arbitrary = oneof [ return ComponentLib
......
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