hackport-0.8.0.0: cabal/Cabal-tests/tests/UnitTests/Distribution/Version.hs
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns
-fno-warn-deprecations
-fno-warn-unused-binds #-} --FIXME
module UnitTests.Distribution.Version (versionTests) where
import Distribution.Compat.Prelude.Internal
import Prelude ()
import Distribution.Parsec (simpleParsec)
import Distribution.Pretty
import Distribution.Types.VersionRange.Internal
import Distribution.Utils.Generic
import Distribution.Version
import Data.Maybe (fromJust)
import Data.Typeable (typeOf)
import Test.QuickCheck (Arbitrary (..), NonEmptyList (..), NonNegative (..), Property, Testable, counterexample, property, (===), (==>), vectorOf, sized, choose, arbitrarySizedNatural)
import Test.QuickCheck.Instances.Cabal ()
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
import qualified Distribution.Types.VersionInterval as New
import qualified Distribution.Types.VersionInterval.Legacy as Old
import qualified Text.PrettyPrint as Disp
versionTests :: [TestTree]
versionTests =
-- test 'Version' type
[ 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
, tp "parsec . prettyShow involutive" prop_parsec_disp_inv
, tp "normaliseVersionRange involutive" prop_normalise_inv
, tp "normaliseVersionRange equivalent" prop_normalise_equiv
, tp "normaliseVersionRange caretequiv" prop_normalise_caret_equiv
, tp "normaliseVersionRange model" prop_normalise_model
, tp "simplifyVersionRange involutive" prop_simplify_inv
, tp "simplifyVersionRange equivalent" prop_simplify_equiv
-- , tp "simplifyVersionRange caretequiv" prop_simplify_caret_equiv
, tp "simpleParsec . prettyShow = Just" prop_parse_disp
]
++
zipWith
(\n (rep, p) -> testProperty ("Range Property " ++ show n ++ " (" ++ show rep ++ ")") p)
[1::Int ..]
-- properties to validate the test framework
[ typProperty prop_nonNull
, typProperty prop_gen_intervals1
, typProperty prop_gen_intervals2
, typProperty prop_anyVersion
, typProperty prop_noVersion
, typProperty prop_thisVersion
, typProperty prop_notThisVersion
, typProperty prop_laterVersion
, typProperty prop_orLaterVersion
, typProperty prop_earlierVersion
, typProperty prop_orEarlierVersion
, typProperty prop_unionVersionRanges
, typProperty prop_intersectVersionRanges
, typProperty prop_withinVersion
, typProperty prop_foldVersionRange
-- converting between version ranges and version intervals
, typProperty prop_to_from_intervals
]
where
tp :: Testable p => String -> p -> TestTree
tp = testProperty
typProperty p = (typeOf p, property p)
-------------------------------------------------------------------------------
-- Arbitrary for inputs of mkVersion
-------------------------------------------------------------------------------
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'
]
---------------------
-- 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
prop_ShowRead :: Version -> Property
prop_ShowRead v = Just v === readMaybe (show v)
prop_ShowRead_example :: Bool
prop_ShowRead_example = show (mkVersion [1,2,3]) == "mkVersion [1,2,3]"
---------------------------
-- VersionRange properties
--
prop_normalise_inv :: VersionRange -> Property
prop_normalise_inv vr = normaliseVersionRange vr === normaliseVersionRange (normaliseVersionRange vr)
prop_normalise_equiv :: VersionRange -> Version -> Property
prop_normalise_equiv vr =
prop_equivalentVersionRange vr (normaliseVersionRange vr)
prop_normalise_caret_equiv :: VersionRange -> Version -> Property
prop_normalise_caret_equiv vr = prop_equivalentVersionRange
(transformCaretUpper vr)
(transformCaretUpper (normaliseVersionRange vr))
prop_normalise_model :: VersionRange -> Property
prop_normalise_model vr =
oldNormaliseVersionRange vr' === newNormaliseVersionRange vr'
where
vr' = transformCaret vr
oldNormaliseVersionRange :: VersionRange -> VersionRange
oldNormaliseVersionRange = Old.fromVersionIntervals . Old.toVersionIntervals
newNormaliseVersionRange :: VersionRange -> VersionRange
newNormaliseVersionRange = New.normaliseVersionRange2
prop_simplify_inv :: VersionRange -> Property
prop_simplify_inv vr =
simplifyVersionRange vr === simplifyVersionRange (simplifyVersionRange vr)
prop_simplify_equiv :: VersionRange -> Version -> Property
prop_simplify_equiv vr v =
counterexample (show vr') $ prop_equivalentVersionRange vr vr' v
where
vr' = simplifyVersionRange vr
-- TODO: Doesn't hold yet
-- prop_simplify_caret_equiv :: VersionRange -> Version -> Property
-- prop_simplify_caret_equiv vr = prop_equivalentVersionRange
-- (transformCaretUpper vr)
-- (transformCaretUpper (simplifyVersionRange vr))
prop_nonNull :: Version -> Bool
prop_nonNull = (/= nullVersion)
prop_anyVersion :: Version -> Bool
prop_anyVersion v' =
withinRange v' anyVersion
prop_noVersion :: Version -> Bool
prop_noVersion v' =
withinRange v' noVersion == False
prop_thisVersion :: Version -> Version -> Bool
prop_thisVersion v v' =
withinRange v' (thisVersion v)
== (v' == v)
prop_notThisVersion :: Version -> Version -> Bool
prop_notThisVersion v v' =
withinRange v' (notThisVersion v)
== (v' /= v)
prop_laterVersion :: Version -> Version -> Bool
prop_laterVersion v v' =
withinRange v' (laterVersion v)
== (v' > v)
prop_orLaterVersion :: Version -> Version -> Bool
prop_orLaterVersion v v' =
withinRange v' (orLaterVersion v)
== (v' >= v)
prop_earlierVersion :: Version -> Version -> Bool
prop_earlierVersion v v' =
withinRange v' (earlierVersion v)
== (v' < v)
prop_orEarlierVersion :: Version -> Version -> Bool
prop_orEarlierVersion v v' =
withinRange v' (orEarlierVersion v)
== (v' <= v)
prop_unionVersionRanges :: VersionRange -> VersionRange -> Version -> Bool
prop_unionVersionRanges vr1 vr2 v' =
withinRange v' (unionVersionRanges vr1 vr2)
== (withinRange v' vr1 || withinRange v' vr2)
prop_intersectVersionRanges :: VersionRange -> VersionRange -> Version -> Bool
prop_intersectVersionRanges vr1 vr2 v' =
withinRange v' (intersectVersionRanges vr1 vr2)
== (withinRange v' vr1 && withinRange v' vr2)
prop_withinVersion :: Version -> Version -> Property
prop_withinVersion v v' =
withinRange v' (withinVersion v)
===
(v' >= v && v' < upper v)
where
upper = alterVersion $ \numbers -> case unsnoc numbers of
Nothing -> []
Just (xs, x) -> xs ++ [x + 1]
prop_foldVersionRange :: VersionRange -> Property
prop_foldVersionRange range =
expandVR range
=== foldVersionRange anyVersion thisVersion
laterVersion earlierVersion
unionVersionRanges intersectVersionRanges
range
where
expandVR (MajorBoundVersion v) =
intersectVersionRanges (expandVR (orLaterVersion v)) (earlierVersion (majorUpperBound v))
expandVR (OrEarlierVersion v) =
unionVersionRanges (thisVersion v) (earlierVersion v)
expandVR (OrLaterVersion v) =
unionVersionRanges (thisVersion v) (laterVersion v)
expandVR (UnionVersionRanges v1 v2) =
UnionVersionRanges (expandVR v1) (expandVR v2)
expandVR (IntersectVersionRanges v1 v2) =
IntersectVersionRanges (expandVR v1) (expandVR v2)
expandVR v = v
upper = alterVersion $ \numbers -> case unsnoc numbers of
Nothing -> []
Just (xs, x) -> xs ++ [x + 1]
prop_isAnyVersion1 :: VersionRange -> Version -> Property
prop_isAnyVersion1 range version =
isAnyVersion range ==> withinRange version range
prop_isAnyVersion2 :: VersionRange -> Property
prop_isAnyVersion2 range =
isAnyVersion range ==>
foldVersionRange True (\_ -> False) (\_ -> False) (\_ -> False)
(\_ _ -> False) (\_ _ -> False)
(simplifyVersionRange range)
prop_isNoVersion :: VersionRange -> Version -> Property
prop_isNoVersion range version =
isNoVersion range ==> not (withinRange version range)
prop_isSpecificVersion1 :: VersionRange -> NonEmptyList Version -> Property
prop_isSpecificVersion1 range (NonEmpty versions) =
isJust version && not (null versions') ==>
allEqual (fromJust version) versions'
where
version = isSpecificVersion range
versions' = filter (`withinRange` range) versions
allEqual x xs = and (zipWith (==) (x:xs) xs)
prop_isSpecificVersion2 :: VersionRange -> Property
prop_isSpecificVersion2 range =
isJust version ==>
foldVersionRange Nothing Just (\_ -> Nothing) (\_ -> Nothing)
(\_ _ -> Nothing) (\_ _ -> Nothing)
(simplifyVersionRange range)
== version
where
version = isSpecificVersion range
-- | Check that our VersionIntervals' arbitrary instance generates intervals
-- that satisfies the invariant.
--
prop_gen_intervals1 :: VersionIntervals -> Property
prop_gen_intervals1 = property . New.invariantVersionIntervals
-- | Check that constructing our intervals type and converting it to a
-- 'VersionRange' and then into the true intervals type gives us back
-- the exact same sequence of intervals. This tells us that our arbitrary
-- instance for 'VersionIntervals'' is ok.
--
prop_gen_intervals2 :: VersionIntervals -> Property
prop_gen_intervals2 intervals =
toVersionIntervals (fromVersionIntervals intervals) === intervals
--
-- | @'toVersionIntervals' . 'fromVersionIntervals'@ is an exact identity on
-- 'VersionIntervals'.
--
prop_to_from_intervals :: VersionIntervals -> Bool
prop_to_from_intervals intervals =
toVersionIntervals (fromVersionIntervals intervals) == intervals
--------------------------------
-- equivalentVersionRange helper
prop_equivalentVersionRange
:: VersionRange -> VersionRange -> Version -> Property
prop_equivalentVersionRange range range' version =
withinRange version range === withinRange version range'
--------------------------------
-- Parsing and pretty printing
--
prop_parsec_disp_inv :: VersionRange -> Property
prop_parsec_disp_inv vr =
parseDisp vr === (parseDisp vr >>= parseDisp)
where
parseDisp = simpleParsec . prettyShow
prop_parse_disp :: VersionRange -> Property
prop_parse_disp vr = counterexample (show (prettyShow vr')) $
fmap s (simpleParsec (prettyShow vr')) === Just vr'
where
-- we have to strip parens, because arbitrary 'VersionRange' may have
-- too little parens constructors.
s = stripParensVersionRange
vr' = s vr
prop_parse_disp1 :: VersionRange -> Bool
prop_parse_disp1 vr =
simpleParsec (prettyShow vr) == Just (normaliseVersionRange vr)
prop_parse_disp2 :: VersionRange -> Property
prop_parse_disp2 vr =
let b = fmap (prettyShow :: VersionRange -> String) (simpleParsec (prettyShow vr))
a = Just (prettyShow vr)
in
counterexample ("Expected: " ++ show a) $
counterexample ("But got: " ++ show b) $
b == a
prop_parse_disp3 :: VersionRange -> Property
prop_parse_disp3 vr =
let a = Just (prettyShow vr)
b = fmap displayRaw (simpleParsec (prettyShow vr))
in
counterexample ("Expected: " ++ show a) $
counterexample ("But got: " ++ show b) $
b == a
prop_parse_disp4 :: VersionRange -> Property
prop_parse_disp4 vr =
let a = Just vr
b = (simpleParsec (prettyShow vr))
in
counterexample ("Expected: " ++ show a) $
counterexample ("But got: " ++ show b) $
b == a
prop_parse_disp5 :: VersionRange -> Property
prop_parse_disp5 vr =
let a = Just vr
b = simpleParsec (displayRaw vr)
in
counterexample ("Expected: " ++ show a) $
counterexample ("But got: " ++ show b) $
b == a
displayRaw :: VersionRange -> String
displayRaw =
Disp.render
. cataVersionRange alg . normaliseVersionRange
where
-- precedence:
-- All the same as the usual pretty printer, except for the parens
alg (ThisVersionF v) = Disp.text "==" <<>> pretty v
alg (LaterVersionF v) = Disp.char '>' <<>> pretty v
alg (EarlierVersionF v) = Disp.char '<' <<>> pretty v
alg (OrLaterVersionF v) = Disp.text ">=" <<>> pretty v
alg (OrEarlierVersionF v) = Disp.text "<=" <<>> pretty v
alg (MajorBoundVersionF v) = Disp.text "^>=" <<>> pretty v
alg (UnionVersionRangesF r1 r2) = r1 <+> Disp.text "||" <+> r2
alg (IntersectVersionRangesF r1 r2) = r1 <+> Disp.text "&&" <+> r2
dispWild v =
Disp.hcat (Disp.punctuate (Disp.char '.')
(map Disp.int (versionNumbers v)))
<<>> Disp.text ".*"