range 0.1.1.0 → 0.1.1.1

raw patch · 2 files changed

+116/−1 lines, 2 filesdep +rangePVP ok

version bump matches the API change (PVP)

Dependencies added: range

API changes (from Hackage documentation)

Files

• Test/RangeMerge.hs +113/−0
• range.cabal +3/−1

@@ -0,0 +1,113 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- This is only okay in test classes++module Test.RangeMerge +   ( rangeMergeTestCases+   ) where++import Test.Framework (testGroup)+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2++import Control.Monad (liftM)+import Data.Maybe (fromMaybe)+import System.Random++import Data.Range.RangeInternal++instance (Num a, Integral a, Ord a, Random a) => Arbitrary (RangeMerge a) where+   arbitrary = do+      upperBound <- maybeNumber+      possibleSpanStart <- arbitrarySizedIntegral+      spans <- generateSpanList (fromMaybe possibleSpanStart upperBound)+      lowerBound <- oneof +         [ fmap Just $ fmap ((+) $ maxMaybe (fmap snd $ lastMaybe spans) $ maxMaybe upperBound possibleSpanStart) $ choose (2, 100)+         , return Nothing+         ]+      return RM +         { largestUpperBound = upperBound+         , largestLowerBound = lowerBound +         , spanRanges = spans+         }+      where+         maybeNumber = oneof [liftM Just arbitrarySizedIntegral, return Nothing]++         lastMaybe :: [a] -> Maybe a+         lastMaybe [] = Nothing+         lastMaybe xs = Just . last $ xs++         maxMaybe :: Ord a => Maybe a -> a -> a+         maxMaybe Nothing x = x+         maxMaybe (Just y) x = max x y++         generateSpanList :: (Num a, Ord a, Random a) => a -> Gen [(a, a)]+         generateSpanList start = do+            count <- choose (0, 10)+            helper count start+            where+               helper :: (Num a, Ord a, Random a) => Integer -> a -> Gen [(a, a)]+               helper 0 _ = return []+               helper x start = do+                  first <- fmap (+start) $ choose (2, 100)+                  second <- fmap (+first) $ choose (2, 100)+                  remainder <- helper (x - 1) second+                  return $ (first, second) : remainder++prop_export_load_is_identity :: RangeMerge Integer -> Bool+prop_export_load_is_identity x = loadRanges (exportRangeMerge x) == x++test_loadRM = testGroup "loadRanges function"+   [ testProperty "loading export results in identity" prop_export_load_is_identity+   ]++prop_invert_twice_is_identity :: RangeMerge Integer -> Bool+prop_invert_twice_is_identity x = (invertRM . invertRM $ x) == x++test_invertRM = testGroup "invertRM function"+   [ testProperty "inverting twice results in identity" prop_invert_twice_is_identity+   ]++prop_union_with_empty_is_self :: RangeMerge Integer -> Bool+prop_union_with_empty_is_self rm = (rm `unionRangeMerges` emptyRangeMerge) == rm++prop_union_with_infinite_is_infinite :: RangeMerge Integer -> Bool+prop_union_with_infinite_is_infinite rm = (rm `unionRangeMerges` IRM) == IRM++test_unionRM = testGroup "unionRangeMerges function"+   [ testProperty "Union with empty is self" prop_union_with_empty_is_self+   , testProperty "Union with infinite is infinite" prop_union_with_infinite_is_infinite+   ]++prop_intersection_with_empty_is_empty :: RangeMerge Integer -> Bool+prop_intersection_with_empty_is_empty rm = +   (rm `intersectionRangeMerges` emptyRangeMerge) == emptyRangeMerge++prop_intersection_with_infinite_is_self :: RangeMerge Integer -> Bool+prop_intersection_with_infinite_is_self rm = +   (rm `intersectionRangeMerges` IRM) == rm++test_intersectionRM = testGroup "intersectionRangeMerges function"+   [ testProperty "Intersection with empty is empty" prop_intersection_with_empty_is_empty +   , testProperty "Intersection with infinite is self" prop_intersection_with_infinite_is_self +   ]++prop_demorgans_law_one :: (RangeMerge Integer, RangeMerge Integer) -> Bool+prop_demorgans_law_one (a, b) = +   (invertRM (a `unionRangeMerges` b)) == ((invertRM a) `intersectionRangeMerges` (invertRM b))++prop_demorgans_law_two :: (RangeMerge Integer, RangeMerge Integer) -> Bool+prop_demorgans_law_two (a, b) = +   (invertRM (a `intersectionRangeMerges` b)) == ((invertRM a) `unionRangeMerges` (invertRM b))++test_complex_laws = testGroup "complex set theory rules"+   [ testProperty "DeMorgan Part 1: not (a or b) == (not a) and (not b)" prop_demorgans_law_one+   , testProperty "DeMorgan Part 2: not (a and b) == (not a) or (not b)" prop_demorgans_law_two+   ]++rangeMergeTestCases =+   [ test_loadRM+   , test_invertRM+   , test_unionRM+   , test_intersectionRM+   , test_complex_laws+   ]

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.0+version:             0.1.1.1  -- A short (one-line) description of the package. synopsis:            This has a bunch of code for specifying and managing ranges in your code.@@ -73,10 +73,12 @@ Test-Suite test-range    type:       exitcode-stdio-1.0    main-is: Test/Range.hs+   other-modules: Test.RangeMerge    build-depends: base                          >= 4.5 && < 5                   , Cabal                       >= 1.14                   , QuickCheck                  >= 2.4.0.1 && < 3                   , test-framework-quickcheck2  >= 0.2 && < 0.4                   , test-framework              >= 0.4 && < 0.9                   , random                      >= 1.0+                  , range    ghc-options: -rtsopts -Wall -fno-enable-rewrite-rules