Commit 931b5a19 authored by kristenk's avatar kristenk
Browse files

Simplify representation of test suites in the solver DSL

This commit removes the 'ExTest' constructor from 'ExampleDependency'.
Test dependencies are now represented using the same
'ExampleDependency' constructors as library dependencies.  The only
difference between dependencies of different components is that they
are placed under different keys in 'D.C.ComponentDeps.ComponentDeps'.
parent f5526ebc
......@@ -3,6 +3,7 @@
module UnitTests.Distribution.Client.Dependency.Modular.DSL (
ExampleDependency(..)
, Dependencies(..)
, ExTest(..)
, ExPreference(..)
, ExampleDb
, ExampleVersionRange
......@@ -18,6 +19,8 @@ module UnitTests.Distribution.Client.Dependency.Modular.DSL (
, exResolve
, extractInstallPlan
, withSetupDeps
, withTest
, withTests
) where
-- base
......@@ -111,9 +114,6 @@ data ExampleDependency =
-- | Dependencies indexed by a flag
| ExFlag ExampleFlagName Dependencies Dependencies
-- | Dependency if tests are enabled
| ExTest ExampleTestName [ExampleDependency]
-- | Dependency on a language extension
| ExExt Extension
......@@ -124,6 +124,8 @@ data ExampleDependency =
| ExPkg (ExamplePkgName, ExamplePkgVersion)
deriving Show
data ExTest = ExTest ExampleTestName [ExampleDependency]
exFlag :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency]
-> ExampleDependency
exFlag n t e = ExFlag n (Buildable t) (Buildable e)
......@@ -155,6 +157,15 @@ withSetupDeps ex setupDeps = ex {
exAvDeps = exAvDeps ex <> CD.fromSetupDeps setupDeps
}
withTest :: ExampleAvailable -> ExTest -> ExampleAvailable
withTest ex test = withTests ex [test]
withTests :: ExampleAvailable -> [ExTest] -> ExampleAvailable
withTests ex tests =
let testCDs = CD.fromList [(CD.ComponentTest name, deps)
| ExTest name deps <- tests]
in ex { exAvDeps = exAvDeps ex <> testCDs }
-- | An installed package in 'ExampleDb'; construct me with 'exInst'.
data ExampleInstalled = ExInst {
exInstName :: ExamplePkgName
......@@ -195,7 +206,8 @@ exDbPkgs = map (either exInstName exAvName)
exAvSrcPkg :: ExampleAvailable -> UnresolvedSourcePackage
exAvSrcPkg ex =
let (libraryDeps, testSuites, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
let (libraryDeps, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)]
in SourcePackage {
packageInfoId = exAvPkgId ex
, packageSource = LocalTarballPackage "<<path>>"
......@@ -212,8 +224,8 @@ exAvSrcPkg ex =
C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex))
}
}
, C.genPackageFlags = nub $ concatMap extractFlags
(CD.libraryDeps (exAvDeps ex))
, C.genPackageFlags = nub $ concatMap extractFlags $
CD.libraryDeps (exAvDeps ex) ++ concatMap snd testSuites
, C.condLibraries = [(exAvName ex, mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs)
disableLib
(Buildable libraryDeps))]
......@@ -229,29 +241,25 @@ exAvSrcPkg ex =
-- the dependencies of the test suites and extensions.
splitTopLevel :: [ExampleDependency]
-> ( [ExampleDependency]
, [(ExampleTestName, [ExampleDependency])]
, [Extension]
, Maybe Language
, [(ExamplePkgName, ExamplePkgVersion)] -- pkg-config
)
splitTopLevel [] =
([], [], [], Nothing, [])
splitTopLevel (ExTest t a:deps) =
let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
in (other, (t, a):testSuites, exts, lang, pcpkgs)
([], [], Nothing, [])
splitTopLevel (ExExt ext:deps) =
let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
in (other, testSuites, ext:exts, lang, pcpkgs)
let (other, exts, lang, pcpkgs) = splitTopLevel deps
in (other, ext:exts, lang, pcpkgs)
splitTopLevel (ExLang lang:deps) =
case splitTopLevel deps of
(other, testSuites, exts, Nothing, pcpkgs) -> (other, testSuites, exts, Just lang, pcpkgs)
(other, exts, Nothing, pcpkgs) -> (other, exts, Just lang, pcpkgs)
_ -> error "Only 1 Language dependency is supported"
splitTopLevel (ExPkg pkg:deps) =
let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
in (other, testSuites, exts, lang, pkg:pcpkgs)
let (other, exts, lang, pcpkgs) = splitTopLevel deps
in (other, exts, lang, pkg:pcpkgs)
splitTopLevel (dep:deps) =
let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
in (dep:other, testSuites, exts, lang, pcpkgs)
let (other, exts, lang, pcpkgs) = splitTopLevel deps
in (dep:other, exts, lang, pcpkgs)
-- Extract the total set of flags used
extractFlags :: ExampleDependency -> [C.Flag]
......@@ -268,7 +276,6 @@ exAvSrcPkg ex =
deps :: Dependencies -> [ExampleDependency]
deps NotBuildable = []
deps (Buildable ds) = ds
extractFlags (ExTest _ a) = concatMap extractFlags a
extractFlags (ExExt _) = []
extractFlags (ExLang _) = []
extractFlags (ExPkg _) = []
......@@ -326,8 +333,6 @@ exAvSrcPkg ex =
splitDeps (ExFlag f a b:deps) =
let (directDeps, flaggedDeps) = splitDeps deps
in (directDeps, (f, a, b):flaggedDeps)
splitDeps (ExTest _ _:_) =
error "Unexpected nested test"
splitDeps (_:deps) = splitDeps deps
-- Currently we only support simple setup dependencies
......
......@@ -168,6 +168,7 @@ arbitraryExInst pn v pkgs = do
arbitraryComponentDeps :: TestDb -> Gen (ComponentDeps [ExampleDependency])
arbitraryComponentDeps (TestDb []) = return $ CD.fromList []
arbitraryComponentDeps db =
-- CD.fromList combines duplicate components.
CD.fromList <$> boundedListOf 3 (arbitraryComponentDep db)
arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency])
......@@ -175,20 +176,18 @@ arbitraryComponentDep db = do
comp <- arbitrary
deps <- case comp of
ComponentSetup -> smallListOf (arbitraryExDep db Setup)
_ -> boundedListOf 5 (arbitraryExDep db TopLevel)
_ -> boundedListOf 5 (arbitraryExDep db NonSetup)
return (comp, deps)
-- | Location of an 'ExampleDependency'. It determines which values are valid.
data ExDepLocation = TopLevel | Nested | Setup
data ExDepLocation = Setup | NonSetup
arbitraryExDep :: TestDb -> ExDepLocation -> Gen ExampleDependency
arbitraryExDep db@(TestDb pkgs) level =
let test = ExTest <$> arbitraryTestName
<*> smallListOf (arbitraryExDep db Nested)
flag = ExFlag <$> arbitraryFlagName
let flag = ExFlag <$> arbitraryFlagName
<*> arbitraryDeps db
<*> arbitraryDeps db
nonNested = [
other = [
ExAny . unPN <$> elements (map getName pkgs)
-- existing version
......@@ -200,19 +199,15 @@ arbitraryExDep db@(TestDb pkgs) level =
]
in oneof $
case level of
TopLevel -> test : flag : nonNested
Nested -> flag : nonNested
Setup -> nonNested
NonSetup -> flag : other
Setup -> other
arbitraryDeps :: TestDb -> Gen Dependencies
arbitraryDeps db = frequency
[ (1, return NotBuildable)
, (20, Buildable <$> smallListOf (arbitraryExDep db Nested))
, (20, Buildable <$> smallListOf (arbitraryExDep db NonSetup))
]
arbitraryTestName :: Gen String
arbitraryTestName = (:[]) <$> elements ['A'..'E']
arbitraryFlagName :: Gen String
arbitraryFlagName = (:[]) <$> elements ['A'..'E']
......@@ -268,8 +263,6 @@ instance Arbitrary ExampleDependency where
shrink (ExAny _) = []
shrink (ExFix pn _) = [ExAny pn]
shrink (ExTest testName deps) =
deps ++ [ExTest testName deps' | deps' <- shrink deps]
shrink (ExFlag flag th el) =
deps th ++ deps el
++ [ExFlag flag th' el | th' <- shrink th]
......
......@@ -325,11 +325,11 @@ db5 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 []
, Right $ exAv "C" 1 [ExTest "testC" [ExAny "A"]]
, Right $ exAv "D" 1 [ExTest "testD" [ExFix "B" 2]]
, Right $ exAv "E" 1 [ExFix "A" 1, ExTest "testE" [ExAny "A"]]
, Right $ exAv "F" 1 [ExFix "A" 1, ExTest "testF" [ExFix "A" 2]]
, Right $ exAv "G" 1 [ExFix "A" 2, ExTest "testG" [ExAny "A"]]
, Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"]
, Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2]
, Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"]
, Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2]
, Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"]
]
-- Now the _dependencies_ have test suites
......@@ -344,7 +344,7 @@ db6 :: ExampleDb
db6 = [
Right $ exAv "A" 1 []
, Right $ exAv "A" 2 []
, Right $ exAv "B" 1 [ExTest "testA" [ExAny "A"]]
, Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"]
, Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
, Right $ exAv "D" 1 [ExAny "B"]
]
......@@ -504,13 +504,13 @@ testBuildable testName unavailableDep =
where
expected = Just [("false-dep", 1), ("pkg", 1)]
db = [
Right $ exAv "pkg" 1 [
unavailableDep
, ExFlag "enable-lib" (Buildable []) NotBuildable
, ExTest "test" [exFlag "enable-lib"
[ExAny "true-dep"]
[ExAny "false-dep"]]
]
Right $ exAv "pkg" 1
[ unavailableDep
, ExFlag "enable-lib" (Buildable []) NotBuildable ]
`withTest`
ExTest "test" [exFlag "enable-lib"
[ExAny "true-dep"]
[ExAny "false-dep"]]
, Right $ exAv "true-dep" 1 []
, Right $ exAv "false-dep" 1 []
]
......@@ -522,8 +522,9 @@ dbBuildable1 = [
Right $ exAv "pkg" 1
[ ExAny "unknown"
, ExFlag "flag1" (Buildable []) NotBuildable
, ExFlag "flag2" (Buildable []) NotBuildable
, ExTest "optional-test"
, ExFlag "flag2" (Buildable []) NotBuildable]
`withTests`
[ ExTest "optional-test"
[ ExAny "unknown"
, ExFlag "flag1"
(Buildable [])
......
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