psqueues-0.2.3.0: tests/Data/PSQ/Class/Tests.hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Data.PSQ.Class.Tests
( tests
) where
import Prelude hiding (null, lookup, map, foldr)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData, rnf)
import Data.Tagged (Tagged (..), untag)
import qualified Data.List as List
import Data.Char (isPrint, isAlphaNum, ord, toLower)
import Data.Foldable (Foldable, foldr)
import Test.QuickCheck (Arbitrary (..), Property,
(==>), forAll)
import Test.HUnit (Assertion, assert, (@?=))
import Test.Framework (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Data.PSQ.Class
import Data.PSQ.Class.Gen
import Data.PSQ.Class.Util
--------------------------------------------------------------------------------
-- Index of tests
--------------------------------------------------------------------------------
tests
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Foldable (psq Int),
Functor (psq Int),
NFData (psq Int Char),
Show (psq Int Char))
=> Tagged psq [Test]
tests = Tagged
[ testCase "rnf" (untag' test_rnf)
, testCase "equality" (untag' test_equality)
, testCase "size" (untag' test_size)
, testCase "size2" (untag' test_size2)
, testCase "empty" (untag' test_empty)
, testCase "lookup" (untag' test_lookup)
, testCase "findMin" (untag' test_findMin)
, testCase "alter" (untag' test_alter)
, testCase "alterMin" (untag' test_alterMin)
, testCase "fromList" (untag' test_fromList)
, testCase "foldr" (untag' test_foldr)
, testProperty "show" (untag' prop_show)
, testProperty "rnf" (untag' prop_rnf)
, testProperty "size" (untag' prop_size)
, testProperty "singleton" (untag' prop_singleton)
, testProperty "memberLookup" (untag' prop_memberLookup)
, testProperty "insertLookup" (untag' prop_insertLookup)
, testProperty "insertDelete" (untag' prop_insertDelete)
, testProperty "insertDeleteView" (untag' prop_insertDeleteView)
, testProperty "deleteNonMember" (untag' prop_deleteNonMember)
, testProperty "deleteMin" (untag' prop_deleteMin)
, testProperty "alter" (untag' prop_alter)
, testProperty "alterMin" (untag' prop_alterMin)
, testProperty "toList" (untag' prop_toList)
, testProperty "keys" (untag' prop_keys)
, testProperty "insertView" (untag' prop_insertView)
, testProperty "deleteView" (untag' prop_deleteView)
, testProperty "map" (untag' prop_map)
, testProperty "fmap" (untag' prop_fmap)
, testProperty "fold'" (untag' prop_fold')
, testProperty "foldr" (untag' prop_foldr)
, testProperty "valid" (untag' prop_valid)
, testProperty "atMostView" (untag' prop_atMostView)
]
where
untag' :: Tagged psq test -> test
untag' = untag
--------------------------------------------------------------------------------
-- HUnit tests
--------------------------------------------------------------------------------
test_rnf
:: forall psq. (PSQ psq, TestKey (Key psq),
NFData (psq Int Char))
=> Tagged psq Assertion
test_rnf = Tagged $
rnf (empty :: psq Int Char) `seq` return ()
test_equality
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char))
=> Tagged psq Assertion
test_equality = Tagged $ do
-- Mostly to get 100% coverage
assert $ e /= s
assert $ s /= e
where
e = empty :: psq Int Char
s = singleton 3 100 'a' :: psq Int Char
test_size
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_size = Tagged $ do
null (empty :: psq Int Char) @?= True
null (singleton 1 100 'a' :: psq Int Char) @?= False
test_size2
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_size2 = Tagged $ do
size (empty :: psq Int ()) @?= 0
size (singleton 1 100 'a' :: psq Int Char) @?= 1
size (fromList [(1, 100, 'a'), (2, 101, 'c'), (3, 102, 'b')]
:: psq Int Char) @?= 3
test_empty
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_empty = Tagged $ do
toList (empty :: psq Int ()) @?= []
size (empty :: psq Char Int) @?= 0
test_lookup
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_lookup = Tagged $ do
employeeCurrency 1 @?= Just 1
employeeCurrency 2 @?= Nothing
where
employeeDept = fromList [(1, 100, 2), (3, 101, 1)] :: psq Int Int
deptCountry = fromList [(1, 102, 1), (2, 103, 2)] :: psq Int Int
countryCurrency = fromList [(1, 104, 2), (2, 105, 1)] :: psq Int Int
employeeCurrency :: Int -> Maybe Int
employeeCurrency name = do
dept <- snd <$> lookup (toTestKey name) employeeDept
country <- snd <$> lookup (toTestKey dept) deptCountry
snd <$> lookup (toTestKey country) countryCurrency
test_findMin
:: forall psq. (PSQ psq, TestKey (Key psq))
=> Tagged psq Assertion
test_findMin = Tagged $ do
findMin (empty :: psq Int Char) @?= Nothing
findMin (fromList [(5, 101, 'a'), (3, 100, 'b')] :: psq Int Char) @?=
Just (3, 100, 'b')
test_alter
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_alter = Tagged $ do
alter f 3 (empty :: psq Int Char) @?= ("Hello", singleton 3 100 'a')
alter f 3 (singleton 3 100 'a' :: psq Int Char) @?= ("World", empty)
alter f 3 (singleton 3 100 'b' :: psq Int Char) @?=
("Cats", singleton 3 101 'b')
where
f Nothing = ("Hello", Just (100, 'a'))
f (Just (100, 'a')) = ("World", Nothing)
f (Just _) = ("Cats", Just (101, 'b'))
test_alterMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_alterMin = Tagged $ do
alterMin (\_ -> ((), Nothing)) (empty :: psq Int Char) @?= ((), empty)
alterMin (\_ -> ((), Nothing)) (singleton 3 100 'a' :: psq Int Char) @?=
((), empty)
test_fromList
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char), Show (psq Int Char))
=> Tagged psq Assertion
test_fromList = Tagged $
let ls = [(1, 0, 'A'), (2, 0, 'B'), (3, 0, 'C'), (4, 0, 'D')]
in (fromList ls :: psq Int Char) @?= fromList (reverse ls)
test_foldr
:: forall psq. (PSQ psq, TestKey (Key psq),
Foldable (psq Int))
=> Tagged psq Assertion
test_foldr = Tagged $
foldr (\x acc -> acc + ord x) 0 (empty :: psq Int Char) @?= 0
--------------------------------------------------------------------------------
-- QuickCheck properties
--------------------------------------------------------------------------------
-- | For 100% test coverage...
prop_show
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq Property
prop_show = Tagged $
forAll arbitraryPSQ $ \t ->
length (coverShowInstance (t :: psq Int Char)) > 0
-- | For 100% test coverage...
prop_rnf
:: forall psq. (PSQ psq, TestKey (Key psq),
NFData (psq Int Char), Show (psq Int Char))
=> Tagged psq Property
prop_rnf = Tagged $
forAll arbitraryPSQ $ \t ->
rnf (t :: psq Int Char) `seq` True
prop_size
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_size = Tagged $ \t ->
size (t :: psq Int Char) == length (toList t)
prop_singleton
:: forall psq. (PSQ psq, TestKey (Key psq),
Eq (psq Int Char))
=> Tagged psq Property
prop_singleton = Tagged $
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \x ->
insert k p x empty == (singleton k p x :: psq Int Char)
prop_memberLookup
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_memberLookup = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
case lookup k (t :: psq Int Char) of
Nothing -> not (member k t)
Just _ -> member k t
prop_insertLookup
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertLookup = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
lookup k (insert k p c (t :: psq Int Char)) == Just (p, c)
prop_insertDelete
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertDelete = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
(lookup k t == Nothing) ==>
(delete k (insert k p c t) == (t :: psq Int Char))
prop_insertDeleteView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertDeleteView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \c ->
case deleteView k (insert k p c (t :: psq Int Char)) of
Nothing -> False
Just (p', c', t')
| member k t -> p' == p && c' == c && size t' < size t
| otherwise -> p' == p && c' == c && t' == t
prop_deleteNonMember
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_deleteNonMember = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
(lookup k t == Nothing) ==> (delete k t == (t :: psq Int Char))
prop_deleteMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_deleteMin = Tagged $ \t ->
let t' = deleteMin t
in if null t
then t' == t
else case findMin t of
Nothing -> False
Just (k, _, _) ->
size t' == size t - 1 && member k t && not (member k t')
prop_alter
:: forall psq. (PSQ psq, TestKey (Key psq),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_alter = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
let ((), t') = alter f k t :: ((), psq Int Char)
in case lookup k t of
Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
where
f Nothing = ((), Just (100, 'a'))
f (Just _) = ((), Nothing)
prop_alterMin
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_alterMin = Tagged $ \t ->
let (mbMin, t') = alterMin f (t :: psq Int Char)
in case mbMin of
Nothing -> t' == singleton 3 100 'a'
Just (k, p, v) ->
findMin t == Just (k, p, v) &&
member k t &&
(case () of
_ | isAlphaNum v -> lookup k t' == Just (fromTestKey k, v)
| isPrint v -> lookup (toTestKey $ ord v) t' ==
Just (ord v, v)
| otherwise -> not (member k t'))
where
f Nothing = (Nothing, Just (3, 100, 'a'))
f (Just (k, p, v))
| isAlphaNum v = (Just (k, p, v), Just (k, fromTestKey k, v))
| isPrint v = (Just (k, p, v), Just (toTestKey (ord v), ord v, v))
| otherwise = (Just (k, p, v), Nothing)
prop_toList
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_toList = Tagged $ \t ->
(t :: psq Int Char) == fromList (toList t)
prop_keys
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_keys = Tagged $ \t ->
List.sort (keys (t :: psq Int Char)) ==
List.sort [k | (k, _, _) <- toList t]
prop_insertView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_insertView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
forAll arbitraryPriority $ \p ->
forAll arbitrary $ \x ->
case insertView k p x (t :: psq Int Char) of
(mbPx, t') ->
lookup k t == mbPx && lookup k t' == Just (p, x)
prop_deleteView
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_deleteView = Tagged $ \t ->
forAll arbitraryTestKey $ \k ->
case deleteView k (t :: psq Int Char) of
Nothing -> not (member k t)
Just (p, v, t') -> lookup k t == Just (p, v) && not (member k t')
prop_map
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_map = Tagged $ \t ->
map f (t :: psq Int Char) ==
fromList (List.map (\(k, p, x) -> (k, p, f k p x)) (toList t))
where
f k p x = if fromEnum k > p then x else 'a'
prop_fmap
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Eq (psq Int Char),
Functor (psq Int),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_fmap = Tagged $ \t ->
fmap toLower (t :: psq Int Char) ==
fromList (List.map (\(p, v, x) -> (p, v, toLower x)) (toList t))
prop_fold'
:: forall psq. (PSQ psq, TestKey (Key psq),
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_fold' = Tagged $ \t ->
fold' f acc0 (t :: psq Int Char) ==
List.foldl' (\acc (k, p, x) -> f k p x acc) acc0 (toList t)
where
-- Needs to be commutative
f k p x (kpSum, xs) = (kpSum + fromEnum k + p, List.sort (x : xs))
acc0 = (0, [])
prop_foldr
:: forall psq. (PSQ psq,
Arbitrary (psq Int Char),
Foldable (psq Int),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_foldr = Tagged $ \t ->
foldr f 0 (t :: psq Int Char) ==
List.foldr (\(_, _, x) acc -> f x acc) 0 (toList t)
where
f x acc = acc + ord x
prop_valid
:: forall psq. (PSQ psq,
Arbitrary (psq Int Char),
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_valid = Tagged valid
prop_atMostView
:: forall psq. (PSQ psq, Show (Key psq), Show (psq Int Char))
=> Tagged psq (psq Int Char -> Property)
prop_atMostView = Tagged $ \t ->
forAll arbitraryPriority $ \p ->
let (elems, t') = atMostView p t in
-- 1. Test that priorities are at most 'p'.
and [p' <= p | (_, p', _) <- elems] &&
-- 2. Test that the remaining priorities are larger than 'p'.
(case findMin t' of
Nothing -> True
Just (_, p', _) -> p' > p) &&
-- 2. Test that the size of the removed elements and the new queue total
-- the original size.
length elems + size t' == size t