Commit d4ba63ec authored by Edsko de Vries's avatar Edsko de Vries
Browse files

Merge pull request #3277 from grayjay/solver-dsl-test-suites

Simplify representation of test suites in the solver DSL
parents 60732d4b 931b5a19
......@@ -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]
......
......@@ -330,11 +330,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
......@@ -349,7 +349,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"]
]
......@@ -532,13 +532,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 []
]
......@@ -550,8 +550,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