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
a98576fb
Commit
a98576fb
authored
Oct 01, 2016
by
Herbert Valerio Riedel
🕺
Browse files
Update test-suite to test more `Version` properties
parent
aabee7c3
Changes
1
Hide whitespace changes
Inline
Side-by-side
Cabal/tests/UnitTests/Distribution/Version.hs
View file @
a98576fb
...
...
@@ -23,6 +23,7 @@ import Control.Monad (liftM, liftM2)
import
Data.Maybe
(
isJust
,
fromJust
)
import
Data.List
(
sort
,
sortBy
,
nub
)
import
Data.Ord
(
comparing
)
import
Data.Function
(
on
)
versionTests
::
[
TestTree
]
versionTests
=
...
...
@@ -34,6 +35,14 @@ versionTests =
--, property prop_equivalentVersionRange --FIXME: runs out of test cases
,
property
prop_intermediateVersion
-- test 'Version' type
,
property
prop_VersionId
,
property
prop_VersionId2
,
property
prop_VersionEq
,
property
prop_VersionEq2
,
property
prop_VersionOrd
,
property
prop_VersionOrd2
-- the basic syntactic version range functions
,
property
prop_anyVersion
,
property
prop_noVersion
...
...
@@ -109,17 +118,42 @@ adjustSize adjust gen = sized (\n -> resize (adjust n) gen)
instance
Arbitrary
Version
where
arbitrary
=
do
branch
<-
smallListOf1
$
frequency
[(
3
,
return
0
)
,(
3
,
return
1
)
,(
2
,
return
2
)
,(
1
,
return
3
)]
return
(
mkVersion
branch
)
branch
<-
smallListOf1
$
frequency
[(
3
,
return
0
)
,(
3
,
return
1
)
,(
2
,
return
2
)
,(
2
,
return
3
)
,(
1
,
return
0xfffd
)
,(
1
,
return
0xfffe
)
-- max fitting into packed W64
,(
1
,
return
0xffff
)
,(
1
,
return
0x10000
)]
return
(
mkVersion
branch
)
where
smallListOf1
=
adjustSize
(
\
n
->
min
5
(
n
`
div
`
3
))
.
listOf1
smallListOf1
=
adjustSize
(
\
n
->
min
6
(
n
`
div
`
3
))
.
listOf1
shrink
ver
=
[
mkVersion
ns
|
ns
<-
shrink
(
versionNumbers
ver
)
,
not
(
null
ns
)
]
shrink
ver
=
[
mkVersion
branch'
|
branch'
<-
shrink
(
versionNumbers
ver
)
,
not
(
null
branch'
)
]
newtype
VersionArb
=
VersionArb
[
Int
]
deriving
(
Eq
,
Ord
,
Show
)
-- | 'Version' instance as used by QC 2.9
instance
Arbitrary
VersionArb
where
arbitrary
=
sized
$
\
n
->
do
k
<-
choose
(
0
,
log2
n
)
xs
<-
vectorOf
(
k
+
1
)
arbitrarySizedNatural
return
(
VersionArb
xs
)
where
log2
::
Int
->
Int
log2
n
|
n
<=
1
=
0
|
otherwise
=
1
+
log2
(
n
`
div
`
2
)
shrink
(
VersionArb
xs
)
=
[
VersionArb
xs'
|
xs'
<-
shrink
xs
,
length
xs'
>
0
,
all
(
>=
0
)
xs'
]
instance
Arbitrary
VersionRange
where
arbitrary
=
sized
verRangeExp
...
...
@@ -147,6 +181,35 @@ instance Arbitrary VersionRange where
orEarlierVersion'
v
=
unionVersionRanges
(
EarlierVersion
v
)
(
ThisVersion
v
)
---------------------
-- Version properties
--
prop_VersionId
::
[
NonNegative
Int
]
->
Bool
prop_VersionId
lst0
=
(
versionNumbers
.
mkVersion
)
lst
==
lst
where
lst
=
map
getNonNegative
lst0
prop_VersionId2
::
VersionArb
->
Bool
prop_VersionId2
(
VersionArb
lst
)
=
(
versionNumbers
.
mkVersion
)
lst
==
lst
prop_VersionEq
::
Version
->
Version
->
Bool
prop_VersionEq
v1
v2
=
(
==
)
v1
v2
==
((
==
)
`
on
`
versionNumbers
)
v1
v2
prop_VersionEq2
::
VersionArb
->
VersionArb
->
Bool
prop_VersionEq2
(
VersionArb
v1
)
(
VersionArb
v2
)
=
(
==
)
v1
v2
==
((
==
)
`
on
`
mkVersion
)
v1
v2
prop_VersionOrd
::
Version
->
Version
->
Bool
prop_VersionOrd
v1
v2
=
compare
v1
v2
==
(
compare
`
on
`
versionNumbers
)
v1
v2
prop_VersionOrd2
::
VersionArb
->
VersionArb
->
Bool
prop_VersionOrd2
(
VersionArb
v1
)
(
VersionArb
v2
)
=
(
==
)
v1
v2
==
((
==
)
`
on
`
mkVersion
)
v1
v2
---------------------------
-- VersionRange properties
--
...
...
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