Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
d4ba63ec
Commit
d4ba63ec
authored
Apr 05, 2016
by
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
Changes
3
Hide whitespace changes
Inline
Side-by-side
cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
View file @
d4ba63ec
...
...
@@ -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
...
...
cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs
View file @
d4ba63ec
...
...
@@ -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
|
Non
Setup
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
N
ested
))
,
(
20
,
Buildable
<$>
smallListOf
(
arbitraryExDep
db
N
onSetup
))
]
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
]
...
...
cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs
View file @
d4ba63ec
...
...
@@ -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
"
fals
e-dep"
]
]
]
Right
$
exAv
"pkg"
1
[
unavailableDep
,
ExFlag
"enable-lib"
(
Buildable
[]
)
NotBuildable
]
`
withTest
`
ExTest
"test"
[
exFlag
"enable-lib"
[
ExAny
"
tru
e-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
[]
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment