1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE FlexibleInstances #-} 3{-# LANGUAGE ScopedTypeVariables #-} 4{-# LANGUAGE TypeFamilies #-} 5module Data.PSQ.Class.Tests 6 ( tests 7 ) where 8 9import Control.Applicative ((<$>)) 10import Control.DeepSeq (NFData, rnf) 11import Data.Char (isAlphaNum, isPrint, ord, toLower) 12import Data.Foldable (Foldable, foldr) 13import qualified Data.List as List 14import Data.Tagged (Tagged (..), untag) 15import Prelude hiding (foldr, lookup, map, null) 16 17import Test.HUnit (Assertion, assert, (@?=)) 18import Test.QuickCheck (Arbitrary (..), Property, forAll, (==>)) 19import Test.Tasty (TestTree) 20import Test.Tasty.HUnit (testCase) 21import Test.Tasty.QuickCheck (testProperty) 22 23import Data.PSQ.Class 24import Data.PSQ.Class.Gen 25import Data.PSQ.Class.Util 26 27 28-------------------------------------------------------------------------------- 29-- Index of tests 30-------------------------------------------------------------------------------- 31 32tests 33 :: forall psq. (PSQ psq, TestKey (Key psq), 34 Arbitrary (psq Int Char), 35 Eq (psq Int Char), 36 Foldable (psq Int), 37 Functor (psq Int), 38 NFData (psq Int Char), 39 Show (psq Int Char)) 40 => Tagged psq [TestTree] 41tests = Tagged 42 [ testCase "rnf" (untag' test_rnf) 43 , testCase "equality" (untag' test_equality) 44 , testCase "size" (untag' test_size) 45 , testCase "size2" (untag' test_size2) 46 , testCase "empty" (untag' test_empty) 47 , testCase "lookup" (untag' test_lookup) 48 , testCase "findMin" (untag' test_findMin) 49 , testCase "alter" (untag' test_alter) 50 , testCase "alterMin" (untag' test_alterMin) 51 , testCase "fromList" (untag' test_fromList) 52 , testCase "foldr" (untag' test_foldr) 53 54 , testProperty "show" (untag' prop_show) 55 , testProperty "rnf" (untag' prop_rnf) 56 , testProperty "size" (untag' prop_size) 57 , testProperty "singleton" (untag' prop_singleton) 58 , testProperty "memberLookup" (untag' prop_memberLookup) 59 , testProperty "insertLookup" (untag' prop_insertLookup) 60 , testProperty "insertDelete" (untag' prop_insertDelete) 61 , testProperty "insertDeleteView" (untag' prop_insertDeleteView) 62 , testProperty "deleteNonMember" (untag' prop_deleteNonMember) 63 , testProperty "deleteMin" (untag' prop_deleteMin) 64 , testProperty "alter" (untag' prop_alter) 65 , testProperty "alterMin" (untag' prop_alterMin) 66 , testProperty "toList" (untag' prop_toList) 67 , testProperty "keys" (untag' prop_keys) 68 , testProperty "insertView" (untag' prop_insertView) 69 , testProperty "deleteView" (untag' prop_deleteView) 70 , testProperty "map" (untag' prop_map) 71 , testProperty "unsafeMapMonotonic" (untag' prop_unsafeMapMonotonic) 72 , testProperty "fmap" (untag' prop_fmap) 73 , testProperty "fold'" (untag' prop_fold') 74 , testProperty "foldr" (untag' prop_foldr) 75 , testProperty "valid" (untag' prop_valid) 76 , testProperty "atMostView" (untag' prop_atMostView) 77 ] 78 where 79 untag' :: Tagged psq test -> test 80 untag' = untag 81 82 83-------------------------------------------------------------------------------- 84-- HUnit tests 85-------------------------------------------------------------------------------- 86 87test_rnf 88 :: forall psq. (PSQ psq, TestKey (Key psq), 89 NFData (psq Int Char)) 90 => Tagged psq Assertion 91test_rnf = Tagged $ 92 rnf (empty :: psq Int Char) `seq` return () 93 94test_equality 95 :: forall psq. (PSQ psq, TestKey (Key psq), 96 Eq (psq Int Char)) 97 => Tagged psq Assertion 98test_equality = Tagged $ do 99 -- Mostly to get 100% coverage 100 assert $ e /= s 101 assert $ s /= e 102 where 103 e = empty :: psq Int Char 104 s = singleton 3 100 'a' :: psq Int Char 105 106test_size 107 :: forall psq. (PSQ psq, TestKey (Key psq)) 108 => Tagged psq Assertion 109test_size = Tagged $ do 110 null (empty :: psq Int Char) @?= True 111 null (singleton 1 100 'a' :: psq Int Char) @?= False 112 113test_size2 114 :: forall psq. (PSQ psq, TestKey (Key psq)) 115 => Tagged psq Assertion 116test_size2 = Tagged $ do 117 size (empty :: psq Int ()) @?= 0 118 size (singleton 1 100 'a' :: psq Int Char) @?= 1 119 size (fromList [(1, 100, 'a'), (2, 101, 'c'), (3, 102, 'b')] 120 :: psq Int Char) @?= 3 121 122test_empty 123 :: forall psq. (PSQ psq, TestKey (Key psq)) 124 => Tagged psq Assertion 125test_empty = Tagged $ do 126 toList (empty :: psq Int ()) @?= [] 127 size (empty :: psq Char Int) @?= 0 128 129test_lookup 130 :: forall psq. (PSQ psq, TestKey (Key psq)) 131 => Tagged psq Assertion 132test_lookup = Tagged $ do 133 employeeCurrency 1 @?= Just 1 134 employeeCurrency 2 @?= Nothing 135 where 136 employeeDept = fromList [(1, 100, 2), (3, 101, 1)] :: psq Int Int 137 deptCountry = fromList [(1, 102, 1), (2, 103, 2)] :: psq Int Int 138 countryCurrency = fromList [(1, 104, 2), (2, 105, 1)] :: psq Int Int 139 140 employeeCurrency :: Int -> Maybe Int 141 employeeCurrency name = do 142 dept <- snd <$> lookup (toTestKey name) employeeDept 143 country <- snd <$> lookup (toTestKey dept) deptCountry 144 snd <$> lookup (toTestKey country) countryCurrency 145 146test_findMin 147 :: forall psq. (PSQ psq, TestKey (Key psq)) 148 => Tagged psq Assertion 149test_findMin = Tagged $ do 150 findMin (empty :: psq Int Char) @?= Nothing 151 findMin (fromList [(5, 101, 'a'), (3, 100, 'b')] :: psq Int Char) @?= 152 Just (3, 100, 'b') 153 154test_alter 155 :: forall psq. (PSQ psq, TestKey (Key psq), 156 Eq (psq Int Char), Show (psq Int Char)) 157 => Tagged psq Assertion 158test_alter = Tagged $ do 159 alter f 3 (empty :: psq Int Char) @?= ("Hello", singleton 3 100 'a') 160 alter f 3 (singleton 3 100 'a' :: psq Int Char) @?= ("World", empty) 161 alter f 3 (singleton 3 100 'b' :: psq Int Char) @?= 162 ("Cats", singleton 3 101 'b') 163 where 164 f Nothing = ("Hello", Just (100, 'a')) 165 f (Just (100, 'a')) = ("World", Nothing) 166 f (Just _) = ("Cats", Just (101, 'b')) 167 168test_alterMin 169 :: forall psq. (PSQ psq, TestKey (Key psq), 170 Eq (psq Int Char), Show (psq Int Char)) 171 => Tagged psq Assertion 172test_alterMin = Tagged $ do 173 alterMin (\_ -> ((), Nothing)) (empty :: psq Int Char) @?= ((), empty) 174 alterMin (\_ -> ((), Nothing)) (singleton 3 100 'a' :: psq Int Char) @?= 175 ((), empty) 176 177test_fromList 178 :: forall psq. (PSQ psq, TestKey (Key psq), 179 Eq (psq Int Char), Show (psq Int Char)) 180 => Tagged psq Assertion 181test_fromList = Tagged $ 182 let ls = [(1, 0, 'A'), (2, 0, 'B'), (3, 0, 'C'), (4, 0, 'D')] 183 in (fromList ls :: psq Int Char) @?= fromList (reverse ls) 184 185test_foldr 186 :: forall psq. (PSQ psq, TestKey (Key psq), 187 Foldable (psq Int)) 188 => Tagged psq Assertion 189test_foldr = Tagged $ 190 foldr (\x acc -> acc + ord x) 0 (empty :: psq Int Char) @?= 0 191 192 193-------------------------------------------------------------------------------- 194-- QuickCheck properties 195-------------------------------------------------------------------------------- 196 197-- | For 100% test coverage... 198prop_show 199 :: forall psq. (PSQ psq, TestKey (Key psq), 200 Show (psq Int Char)) 201 => Tagged psq Property 202prop_show = Tagged $ 203 forAll arbitraryPSQ $ \t -> 204 length (coverShowInstance (t :: psq Int Char)) > 0 205 206-- | For 100% test coverage... 207prop_rnf 208 :: forall psq. (PSQ psq, TestKey (Key psq), 209 NFData (psq Int Char), Show (psq Int Char)) 210 => Tagged psq Property 211prop_rnf = Tagged $ 212 forAll arbitraryPSQ $ \t -> 213 rnf (t :: psq Int Char) `seq` True 214 215prop_size 216 :: forall psq. (PSQ psq, TestKey (Key psq), 217 Show (psq Int Char)) 218 => Tagged psq (psq Int Char -> Bool) 219prop_size = Tagged $ \t -> 220 size (t :: psq Int Char) == length (toList t) 221 222prop_singleton 223 :: forall psq. (PSQ psq, TestKey (Key psq), 224 Eq (psq Int Char)) 225 => Tagged psq Property 226prop_singleton = Tagged $ 227 forAll arbitraryTestKey $ \k -> 228 forAll arbitraryPriority $ \p -> 229 forAll arbitrary $ \x -> 230 insert k p x empty == (singleton k p x :: psq Int Char) 231 232prop_memberLookup 233 :: forall psq. (PSQ psq, TestKey (Key psq), 234 Arbitrary (psq Int Char), 235 Show (psq Int Char)) 236 => Tagged psq (psq Int Char -> Property) 237prop_memberLookup = Tagged $ \t -> 238 forAll arbitraryTestKey $ \k -> 239 case lookup k (t :: psq Int Char) of 240 Nothing -> not (member k t) 241 Just _ -> member k t 242 243prop_insertLookup 244 :: forall psq. (PSQ psq, TestKey (Key psq), 245 Arbitrary (psq Int Char), 246 Show (psq Int Char)) 247 => Tagged psq (psq Int Char -> Property) 248prop_insertLookup = Tagged $ \t -> 249 forAll arbitraryTestKey $ \k -> 250 forAll arbitraryPriority $ \p -> 251 forAll arbitrary $ \c -> 252 lookup k (insert k p c (t :: psq Int Char)) == Just (p, c) 253 254prop_insertDelete 255 :: forall psq. (PSQ psq, TestKey (Key psq), 256 Arbitrary (psq Int Char), 257 Eq (psq Int Char), 258 Show (psq Int Char)) 259 => Tagged psq (psq Int Char -> Property) 260prop_insertDelete = Tagged $ \t -> 261 forAll arbitraryTestKey $ \k -> 262 forAll arbitraryPriority $ \p -> 263 forAll arbitrary $ \c -> 264 (lookup k t == Nothing) ==> 265 (delete k (insert k p c t) == (t :: psq Int Char)) 266 267prop_insertDeleteView 268 :: forall psq. (PSQ psq, TestKey (Key psq), 269 Arbitrary (psq Int Char), 270 Eq (psq Int Char), 271 Show (psq Int Char)) 272 => Tagged psq (psq Int Char -> Property) 273prop_insertDeleteView = Tagged $ \t -> 274 forAll arbitraryTestKey $ \k -> 275 forAll arbitraryPriority $ \p -> 276 forAll arbitrary $ \c -> 277 case deleteView k (insert k p c (t :: psq Int Char)) of 278 Nothing -> False 279 Just (p', c', t') 280 | member k t -> p' == p && c' == c && size t' < size t 281 | otherwise -> p' == p && c' == c && t' == t 282 283prop_deleteNonMember 284 :: forall psq. (PSQ psq, TestKey (Key psq), 285 Arbitrary (psq Int Char), 286 Eq (psq Int Char), 287 Show (psq Int Char)) 288 => Tagged psq (psq Int Char -> Property) 289prop_deleteNonMember = Tagged $ \t -> 290 forAll arbitraryTestKey $ \k -> 291 (lookup k t == Nothing) ==> (delete k t == (t :: psq Int Char)) 292 293prop_deleteMin 294 :: forall psq. (PSQ psq, TestKey (Key psq), 295 Arbitrary (psq Int Char), 296 Eq (psq Int Char), 297 Show (psq Int Char)) 298 => Tagged psq (psq Int Char -> Bool) 299prop_deleteMin = Tagged $ \t -> 300 let t' = deleteMin t 301 in if null t 302 then t' == t 303 else case findMin t of 304 Nothing -> False 305 Just (k, _, _) -> 306 size t' == size t - 1 && member k t && not (member k t') 307 308prop_alter 309 :: forall psq. (PSQ psq, TestKey (Key psq), 310 Show (psq Int Char)) 311 => Tagged psq (psq Int Char -> Property) 312prop_alter = Tagged $ \t -> 313 forAll arbitraryTestKey $ \k -> 314 let ((), t') = alter f k t :: ((), psq Int Char) 315 in case lookup k t of 316 Just _ -> (size t - 1) == size t' && lookup k t' == Nothing 317 Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing 318 where 319 f Nothing = ((), Just (100, 'a')) 320 f (Just _) = ((), Nothing) 321 322prop_alterMin 323 :: forall psq. (PSQ psq, TestKey (Key psq), 324 Arbitrary (psq Int Char), 325 Eq (psq Int Char), 326 Show (psq Int Char)) 327 => Tagged psq (psq Int Char -> Bool) 328prop_alterMin = Tagged $ \t -> 329 let (mbMin, t') = alterMin f (t :: psq Int Char) 330 in case mbMin of 331 Nothing -> t' == singleton 3 100 'a' 332 Just (k, p, v) -> 333 findMin t == Just (k, p, v) && 334 member k t && 335 (case () of 336 _ | isAlphaNum v -> lookup k t' == Just (fromTestKey k, v) 337 | isPrint v -> lookup (toTestKey $ ord v) t' == 338 Just (ord v, v) 339 | otherwise -> not (member k t')) 340 where 341 f Nothing = (Nothing, Just (3, 100, 'a')) 342 f (Just (k, p, v)) 343 | isAlphaNum v = (Just (k, p, v), Just (k, fromTestKey k, v)) 344 | isPrint v = (Just (k, p, v), Just (toTestKey (ord v), ord v, v)) 345 | otherwise = (Just (k, p, v), Nothing) 346 347prop_toList 348 :: forall psq. (PSQ psq, TestKey (Key psq), 349 Arbitrary (psq Int Char), 350 Eq (psq Int Char), 351 Show (psq Int Char)) 352 => Tagged psq (psq Int Char -> Bool) 353prop_toList = Tagged $ \t -> 354 (t :: psq Int Char) == fromList (toList t) 355 356prop_keys 357 :: forall psq. (PSQ psq, TestKey (Key psq), 358 Arbitrary (psq Int Char), 359 Show (psq Int Char)) 360 => Tagged psq (psq Int Char -> Bool) 361prop_keys = Tagged $ \t -> 362 List.sort (keys (t :: psq Int Char)) == 363 List.sort [k | (k, _, _) <- toList t] 364 365prop_insertView 366 :: forall psq. (PSQ psq, TestKey (Key psq), 367 Arbitrary (psq Int Char), 368 Show (psq Int Char)) 369 => Tagged psq (psq Int Char -> Property) 370prop_insertView = Tagged $ \t -> 371 forAll arbitraryTestKey $ \k -> 372 forAll arbitraryPriority $ \p -> 373 forAll arbitrary $ \x -> 374 case insertView k p x (t :: psq Int Char) of 375 (mbPx, t') -> 376 lookup k t == mbPx && lookup k t' == Just (p, x) 377 378prop_deleteView 379 :: forall psq. (PSQ psq, TestKey (Key psq), 380 Arbitrary (psq Int Char), 381 Show (psq Int Char)) 382 => Tagged psq (psq Int Char -> Property) 383prop_deleteView = Tagged $ \t -> 384 forAll arbitraryTestKey $ \k -> 385 case deleteView k (t :: psq Int Char) of 386 Nothing -> not (member k t) 387 Just (p, v, t') -> lookup k t == Just (p, v) && not (member k t') 388 389prop_map 390 :: forall psq. (PSQ psq, TestKey (Key psq), 391 Arbitrary (psq Int Char), 392 Eq (psq Int Char), 393 Show (psq Int Char)) 394 => Tagged psq (psq Int Char -> Bool) 395prop_map = Tagged $ \t -> 396 map f (t :: psq Int Char) == 397 fromList (List.map (\(k, p, x) -> (k, p, f k p x)) (toList t)) 398 where 399 f k p x = if fromEnum k > p then x else 'a' 400 401prop_unsafeMapMonotonic 402 :: forall psq. (PSQ psq, TestKey (Key psq), 403 Arbitrary (psq Int Char), 404 Eq (psq Int Char), 405 Show (psq Int Char)) 406 => Tagged psq (psq Int Char -> Bool) 407prop_unsafeMapMonotonic = Tagged $ \t -> 408 let t' = unsafeMapMonotonic f (t :: psq Int Char) :: psq Int Char in 409 valid t' && 410 t' == fromList (List.map (\(k, p, x) -> let (p', x') = f k p x in (k, p', x')) 411 (toList t)) 412 where 413 f k p x = (p + 1, if fromEnum k > p then x else 'a') 414 415prop_fmap 416 :: forall psq. (PSQ psq, TestKey (Key psq), 417 Arbitrary (psq Int Char), 418 Eq (psq Int Char), 419 Functor (psq Int), 420 Show (psq Int Char)) 421 => Tagged psq (psq Int Char -> Bool) 422prop_fmap = Tagged $ \t -> 423 fmap toLower (t :: psq Int Char) == 424 fromList (List.map (\(p, v, x) -> (p, v, toLower x)) (toList t)) 425 426prop_fold' 427 :: forall psq. (PSQ psq, TestKey (Key psq), 428 Arbitrary (psq Int Char), 429 Show (psq Int Char)) 430 => Tagged psq (psq Int Char -> Bool) 431prop_fold' = Tagged $ \t -> 432 fold' f acc0 (t :: psq Int Char) == 433 List.foldl' (\acc (k, p, x) -> f k p x acc) acc0 (toList t) 434 where 435 -- Needs to be commutative 436 f k p x (kpSum, xs) = (kpSum + fromEnum k + p, List.sort (x : xs)) 437 acc0 = (0, []) 438 439prop_foldr 440 :: forall psq. (PSQ psq, 441 Arbitrary (psq Int Char), 442 Foldable (psq Int), 443 Show (psq Int Char)) 444 => Tagged psq (psq Int Char -> Bool) 445prop_foldr = Tagged $ \t -> 446 foldr f 0 (t :: psq Int Char) == 447 List.foldr (\(_, _, x) acc -> f x acc) 0 (toList t) 448 where 449 f x acc = acc + ord x 450 451prop_valid 452 :: forall psq. (PSQ psq, 453 Arbitrary (psq Int Char), 454 Show (psq Int Char)) 455 => Tagged psq (psq Int Char -> Bool) 456prop_valid = Tagged valid 457 458prop_atMostView 459 :: forall psq. (PSQ psq, Show (Key psq), Show (psq Int Char)) 460 => Tagged psq (psq Int Char -> Property) 461prop_atMostView = Tagged $ \t -> 462 forAll arbitraryPriority $ \p -> 463 let (elems, t') = atMostView p t in 464 -- 1. Test that priorities are at most 'p'. 465 and [p' <= p | (_, p', _) <- elems] && 466 -- 2. Test that the remaining priorities are larger than 'p'. 467 (case findMin t' of 468 Nothing -> True 469 Just (_, p', _) -> p' > p) && 470 -- 2. Test that the size of the removed elements and the new queue total 471 -- the original size. 472 length elems + size t' == size t 473