Commit 0ce2dba5 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #3973 from phadej/version-show

Show Version returning "mkVersion [...]"
parents 34eecf48 5a074395
......@@ -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
......
{-# 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 Data.Monoid
#endif
import Prelude ()
import Distribution.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
......
{-# 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
--
......
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