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
0ce2dba5
Commit
0ce2dba5
authored
Oct 12, 2016
by
Oleg Grenrus
Committed by
GitHub
Oct 12, 2016
Browse files
Merge pull request #3973 from phadej/version-show
Show Version returning "mkVersion [...]"
parents
34eecf48
5a074395
Changes
3
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Version.hs
View file @
0ce2dba5
...
...
@@ -92,6 +92,8 @@ import qualified Text.PrettyPrint as Disp
import
Text.PrettyPrint
((
<+>
))
import
Control.Exception
(
assert
)
import
qualified
Text.Read
as
Read
-- -----------------------------------------------------------------------------
-- Versions
...
...
@@ -113,7 +115,7 @@ data Version = PV0 {-# UNPACK #-} !Word64
-- which all fall into the [0..0xfffe] range), then PV0
-- MUST be used. This is essential for the 'Eq' instance
-- to work.
deriving
(
Data
,
Eq
,
Generic
,
Show
,
Read
,
Typeable
)
deriving
(
Data
,
Eq
,
Generic
,
Typeable
)
instance
Ord
Version
where
compare
(
PV0
x
)
(
PV0
y
)
=
compare
x
y
...
...
@@ -137,6 +139,17 @@ instance Ord Version where
y3
=
fromIntegral
((
w
`
shiftR
`
16
)
.&.
0xffff
)
-
1
y4
=
fromIntegral
(
w
.&.
0xffff
)
-
1
instance
Show
Version
where
showsPrec
d
v
=
showParen
(
d
>
10
)
$
showString
"mkVersion "
.
showsPrec
11
(
versionNumbers
v
)
instance
Read
Version
where
readPrec
=
Read
.
parens
$
do
Read
.
Ident
"mkVersion"
<-
Read
.
lexP
v
<-
Read
.
step
Read
.
readPrec
return
(
mkVersion
v
)
instance
Binary
Version
instance
NFData
Version
where
...
...
Cabal/tests/UnitTests/Distribution/Utils/NubList.hs
View file @
0ce2dba5
{-# LANGUAGE CPP #-}
-- to suppress WARNING in "Distribution.Compat.Prelude.Internal"
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module
UnitTests.Distribution.Utils.NubList
(
tests
)
where
#
if
__GLASGOW_HASKELL__
<
710
import
D
ata.Monoid
#
endif
import
Prelude
()
import
D
istribution.Compat.Prelude.Internal
import
Distribution.Utils.NubList
import
Test.Tasty
import
Test.Tasty.HUnit
...
...
@@ -13,10 +14,15 @@ import Test.Tasty.QuickCheck
tests
::
[
TestTree
]
tests
=
[
testCase
"Numlist retains ordering"
testOrdering
,
testCase
"Numlist removes duplicates"
testDeDupe
,
testProperty
"Monoid Numlist Identity"
prop_Identity
,
testProperty
"Monoid Numlist Associativity"
prop_Associativity
[
testCase
"NubList retains ordering example"
testOrdering
,
testCase
"NubList removes duplicates example"
testDeDupe
,
testProperty
"NubList retains ordering"
prop_Ordering
,
testProperty
"NubList removes duplicates"
prop_DeDupe
,
testProperty
"fromNubList . toNubList = nub"
prop_Nub
,
testProperty
"Monoid NubList Identity"
prop_Identity
,
testProperty
"Monoid NubList Associativity"
prop_Associativity
-- NubListR
,
testProperty
"NubListR removes duplicates from the right"
prop_DeDupeR
]
someIntList
::
[
Int
]
...
...
@@ -36,6 +42,30 @@ testDeDupe =
-- ---------------------------------------------------------------------------
-- QuickCheck properties for NubList
prop_Ordering
::
[
Int
]
->
Property
prop_Ordering
xs
=
mempty
<>
toNubList
xs'
===
toNubList
xs'
<>
mempty
where
xs'
=
nub
xs
prop_DeDupe
::
[
Int
]
->
Property
prop_DeDupe
xs
=
fromNubList
(
toNubList
(
xs'
++
xs
))
===
xs'
-- Note, we append primeless xs
where
xs'
=
nub
xs
prop_DeDupeR
::
[
Int
]
->
Property
prop_DeDupeR
xs
=
fromNubListR
(
toNubListR
(
xs
++
xs'
))
===
xs'
-- Note, we prepend primeless xs
where
xs'
=
nub
xs
prop_Nub
::
[
Int
]
->
Property
prop_Nub
xs
=
rhs
===
lhs
where
rhs
=
fromNubList
(
toNubList
xs
)
lhs
=
nub
xs
prop_Identity
::
[
Int
]
->
Bool
prop_Identity
xs
=
mempty
`
mappend
`
toNubList
xs
==
toNubList
xs
`
mappend
`
mempty
...
...
Cabal/tests/UnitTests/Distribution/Version.hs
View file @
0ce2dba5
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans
-fno-warn-incomplete-patterns
-fno-warn-deprecations
...
...
@@ -21,79 +22,89 @@ import Data.Maybe (isJust, fromJust)
import
Data.List
(
sort
,
sortBy
,
nub
)
import
Data.Ord
(
comparing
)
import
Data.Function
(
on
)
#
if
MIN_VERSION_base
(
4
,
6
,
0
)
import
Text.Read
(
readMaybe
)
#
endif
versionTests
::
[
TestTree
]
versionTests
=
zipWith
(
\
n
p
->
testProperty
(
"Range Property "
++
show
n
)
p
)
[
1
::
Int
..
]
-- properties to validate the test framework
[
property
prop_nonNull
,
property
prop_gen_intervals1
,
property
prop_gen_intervals2
--, 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
,
property
prop_thisVersion
,
property
prop_notThisVersion
,
property
prop_laterVersion
,
property
prop_orLaterVersion
,
property
prop_earlierVersion
,
property
prop_orEarlierVersion
,
property
prop_unionVersionRanges
,
property
prop_intersectVersionRanges
,
property
prop_differenceVersionRanges
,
property
prop_invertVersionRange
,
property
prop_withinVersion
,
property
prop_foldVersionRange
,
property
prop_foldVersionRange'
-- the semantic query functions
--, property prop_isAnyVersion1 --FIXME: runs out of test cases
--, property prop_isAnyVersion2 --FIXME: runs out of test cases
--, property prop_isNoVersion --FIXME: runs out of test cases
--, property prop_isSpecificVersion1 --FIXME: runs out of test cases
--, property prop_isSpecificVersion2 --FIXME: runs out of test cases
,
property
prop_simplifyVersionRange1
,
property
prop_simplifyVersionRange1'
--, property prop_simplifyVersionRange2 --FIXME: runs out of test cases
--, property prop_simplifyVersionRange2' --FIXME: runs out of test cases
--, property prop_simplifyVersionRange2'' --FIXME: actually wrong
-- converting between version ranges and version intervals
,
property
prop_to_intervals
--, property prop_to_intervals_canonical --FIXME: runs out of test cases
--, property prop_to_intervals_canonical' --FIXME: runs out of test cases
,
property
prop_from_intervals
,
property
prop_to_from_intervals
,
property
prop_from_to_intervals
,
property
prop_from_to_intervals'
-- union and intersection of version intervals
,
property
prop_unionVersionIntervals
,
property
prop_unionVersionIntervals_idempotent
,
property
prop_unionVersionIntervals_commutative
,
property
prop_unionVersionIntervals_associative
,
property
prop_intersectVersionIntervals
,
property
prop_intersectVersionIntervals_idempotent
,
property
prop_intersectVersionIntervals_commutative
,
property
prop_intersectVersionIntervals_associative
,
property
prop_union_intersect_distributive
,
property
prop_intersect_union_distributive
-- inversion of version intervals
,
property
prop_invertVersionIntervals
,
property
prop_invertVersionIntervalsTwice
]
[
tp
"versionNumbers . mkVersion = id @[NonNegative Int]"
prop_VersionId
,
tp
"versionNumbers . mkVersion = id @Base.Version"
prop_VersionId2
,
tp
"(==) = (==) `on` versionNumbers"
prop_VersionEq
,
tp
"(==) = (==) `on` mkVersion"
prop_VersionEq2
,
tp
"compare = compare `on` versionNumbers"
prop_VersionOrd
,
tp
"compare = compare `on` mkVersion"
prop_VersionOrd2
,
tp
"readMaybe . show = Just"
prop_ShowRead
,
tp
"read example"
prop_ShowRead_example
]
++
zipWith
(
\
n
p
->
testProperty
(
"Range Property "
++
show
n
)
p
)
[
1
::
Int
..
]
-- properties to validate the test framework
[
property
prop_nonNull
,
property
prop_gen_intervals1
,
property
prop_gen_intervals2
--, property prop_equivalentVersionRange --FIXME: runs out of test cases
,
property
prop_intermediateVersion
,
property
prop_anyVersion
,
property
prop_noVersion
,
property
prop_thisVersion
,
property
prop_notThisVersion
,
property
prop_laterVersion
,
property
prop_orLaterVersion
,
property
prop_earlierVersion
,
property
prop_orEarlierVersion
,
property
prop_unionVersionRanges
,
property
prop_intersectVersionRanges
,
property
prop_differenceVersionRanges
,
property
prop_invertVersionRange
,
property
prop_withinVersion
,
property
prop_foldVersionRange
,
property
prop_foldVersionRange'
-- the semantic query functions
--, property prop_isAnyVersion1 --FIXME: runs out of test cases
--, property prop_isAnyVersion2 --FIXME: runs out of test cases
--, property prop_isNoVersion --FIXME: runs out of test cases
--, property prop_isSpecificVersion1 --FIXME: runs out of test cases
--, property prop_isSpecificVersion2 --FIXME: runs out of test cases
,
property
prop_simplifyVersionRange1
,
property
prop_simplifyVersionRange1'
--, property prop_simplifyVersionRange2 --FIXME: runs out of test cases
--, property prop_simplifyVersionRange2' --FIXME: runs out of test cases
--, property prop_simplifyVersionRange2'' --FIXME: actually wrong
-- converting between version ranges and version intervals
,
property
prop_to_intervals
--, property prop_to_intervals_canonical --FIXME: runs out of test cases
--, property prop_to_intervals_canonical' --FIXME: runs out of test cases
,
property
prop_from_intervals
,
property
prop_to_from_intervals
,
property
prop_from_to_intervals
,
property
prop_from_to_intervals'
-- union and intersection of version intervals
,
property
prop_unionVersionIntervals
,
property
prop_unionVersionIntervals_idempotent
,
property
prop_unionVersionIntervals_commutative
,
property
prop_unionVersionIntervals_associative
,
property
prop_intersectVersionIntervals
,
property
prop_intersectVersionIntervals_idempotent
,
property
prop_intersectVersionIntervals_commutative
,
property
prop_intersectVersionIntervals_associative
,
property
prop_union_intersect_distributive
,
property
prop_intersect_union_distributive
-- inversion of version intervals
,
property
prop_invertVersionIntervals
,
property
prop_invertVersionIntervalsTwice
]
where
tp
::
Testable
p
=>
String
->
p
->
TestTree
tp
=
testProperty
-- parseTests :: [TestTree]
-- parseTests =
...
...
@@ -204,6 +215,17 @@ prop_VersionOrd2 :: VersionArb -> VersionArb -> Bool
prop_VersionOrd2
(
VersionArb
v1
)
(
VersionArb
v2
)
=
(
==
)
v1
v2
==
((
==
)
`
on
`
mkVersion
)
v1
v2
prop_ShowRead
::
Version
->
Property
#
if
MIN_VERSION_base
(
4
,
6
,
0
)
prop_ShowRead
v
=
Just
v
===
readMaybe
(
show
v
)
#
else
-- readMaybe is since base-4.6
prop_ShowRead
v
=
v
===
read
(
show
v
)
#
endif
prop_ShowRead_example
::
Bool
prop_ShowRead_example
=
show
(
mkVersion
[
1
,
2
,
3
])
==
"mkVersion [1,2,3]"
---------------------------
-- 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