{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} -- -- QuickCheck properties for Data.IntMap -- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. intmap-properties.hs import Data.IntMap import Data.Monoid import Data.Maybe hiding (mapMaybe) import Data.Ord import Data.Function import Test.QuickCheck import Text.Show.Functions import Prelude hiding (lookup, null, map ,filter) import qualified Prelude (map, filter) import qualified Data.List as List import Control.Applicative ((<$>),(<*>)) import Data.List (nub,sort) import qualified Data.List as L ((\\),intersect) import qualified Data.IntSet import Data.Maybe (isJust,fromJust) import Prelude hiding (lookup,map,filter,null) import qualified Prelude as P (map) import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit hiding (Test, Testable) import Test.QuickCheck type Map = IntMap main = do -- q $ label "prop_Valid" prop_Valid q $ label "prop_Single" prop_Single -- q $ label "prop_InsertValid" prop_InsertValid q $ label "prop_InsertDelete" prop_InsertDelete -- q $ label "prop_DeleteValid" prop_DeleteValid -- q $ label "prop_Join" prop_Join -- q $ label "prop_Merge" prop_Merge -- q $ label "prop_UnionValid" prop_UnionValid q $ label "prop_UnionInsert" prop_UnionInsert q $ label "prop_UnionAssoc" prop_UnionAssoc q $ label "prop_UnionComm" prop_UnionComm -- q $ label "prop_UnionWithValid" prop_UnionWithValid q $ label "prop_UnionWith" prop_UnionWith -- q $ label "prop_DiffValid" prop_DiffValid q $ label "prop_Diff" prop_Diff q $ label "prop_Diff2" prop_Diff2 -- q $ label "prop_IntValid" prop_IntValid q $ label "prop_Int" prop_Int q $ label "prop_Ordered" prop_Ordered q $ label "prop_List" prop_List -- new tests q $ label "prop_index" prop_index q $ label "prop_null" prop_null q $ label "prop_member" prop_member q $ label "prop_notmember" prop_notmember q $ label "prop_findWithDefault" prop_findWithDefault -- q $ label "prop_findIndex" prop_findIndex q $ label "prop_findMin" prop_findMin q $ label "prop_findMax" prop_findMax q $ label "prop_filter" prop_filter q $ label "prop_partition" prop_partition q $ label "prop_map" prop_map q $ label "prop_fmap" prop_fmap -- q $ label "prop_mapkeys" prop_mapkeys -- q $ label "prop_foldr" prop_foldr -- q $ label "prop_foldl" prop_foldl -- q $ label "prop_foldl'" prop_foldl' q $ label "prop_fold" prop_fold q $ label "prop_folWithKeyd" prop_foldWithKey defaultMain tests where q :: Testable prop => prop -> IO () q = quickCheckWith args {-------------------------------------------------------------------- Testing --------------------------------------------------------------------} testTree xs = fromList [(x,"*") | x <- xs] test1 = testTree [1..20] test2 = testTree [30,29..10] test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] {-------------------------------------------------------------------- QuickCheck --------------------------------------------------------------------} args = stdArgs { maxSuccess = 500 , maxDiscard = 500 } {- qcheck prop = check config prop where config = Config { configMaxTest = 500 , configMaxFail = 5000 , configSize = \n -> (div n 2 + 3) , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } -} {-------------------------------------------------------------------- Arbitrary, reasonably balanced trees --------------------------------------------------------------------} -- instance (Arbitrary a) => Arbitrary (IntMap a) where -- arbitrary = sized (arbtree 0 maxkey) -- where maxkey = 10^5 instance Arbitrary a => Arbitrary (IntMap a) where arbitrary = do{ ks <- arbitrary ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks ; return (fromList xs) } {- -- -- requires access to internals -- arbtree :: (Arbitrary a) => Int -> Int -> Int -> Gen (IntMap a) arbtree lo hi n | n <= 0 = return empty | lo >= hi = return empty | otherwise = do{ x <- arbitrary ; i <- choose (lo,hi) ; m <- choose (1,70) ; let (ml,mr) | m==(1::Int)= (1,2) | m==2 = (2,1) | m==3 = (1,1) | otherwise = (2,2) ; l <- arbtree lo (i-1) (n `div` ml) ; r <- arbtree (i+1) hi (n `div` mr) ; return (unions [singleton (toEnum i) x, l, r ]) } -} {-------------------------------------------------------------------- Valid tree's --------------------------------------------------------------------} forValid :: (Show a,Arbitrary a,Testable b) => (Map a -> b) -> Property forValid f = forAll arbitrary $ \t -> -- classify (balanced t) "balanced" $ classify (size t == 0) "empty" $ classify (size t > 0 && size t <= 10) "small" $ classify (size t > 10 && size t <= 64) "medium" $ classify (size t > 64) "large" $ {-balanced t ==>-} f t forValidIntTree :: Testable a => (Map Int -> a) -> Property forValidIntTree f = forValid f forValidUnitTree :: Testable a => (Map () -> a) -> Property forValidUnitTree f = forValid f -- prop_Valid -- = forValidUnitTree $ \t -> valid t {-------------------------------------------------------------------- Single, Insert, Delete --------------------------------------------------------------------} prop_Single :: Int -> Int -> Bool prop_Single k x = (insert k x empty == singleton k x) -- prop_InsertValid :: Int -> Property -- prop_InsertValid k -- = forValidUnitTree $ \t -> valid (insert k () t) prop_InsertDelete :: Int -> Map () -> Property prop_InsertDelete k t = (lookup k t == Nothing) ==> delete k (insert k () t) == t -- prop_DeleteValid :: Int -> Property -- prop_DeleteValid k -- = forValidUnitTree $ \t -> -- valid (delete k (insert k () t)) {-------------------------------------------------------------------- Balance --------------------------------------------------------------------} {- prop_Join :: Int -> Property prop_Join k = forValidUnitTree $ \t -> let (l,r) = split k t in valid (join k () l r) -} {- prop_Merge :: Int -> Property prop_Merge k = forValidUnitTree $ \t -> let (l,r) = split k t in valid (merge l r) -} {-------------------------------------------------------------------- Union --------------------------------------------------------------------} {- prop_UnionValid :: Property prop_UnionValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (union t1 t2) -} prop_UnionInsert :: Int -> Int -> Map Int -> Bool prop_UnionInsert k x t = union (singleton k x) t == insert k x t prop_UnionAssoc :: Map Int -> Map Int -> Map Int -> Bool prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_UnionComm :: Map Int -> Map Int -> Bool prop_UnionComm t1 t2 = (union t1 t2 == unionWith (\x y -> y) t2 t1) {- prop_UnionWithValid = forValidIntTree $ \t1 -> forValidIntTree $ \t2 -> valid (unionWithKey (\k x y -> x+y) t1 t2) -} prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_UnionWith xs ys = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys))) == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys)) {- prop_DiffValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (difference t1 t2) -} prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_Diff xs ys = List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys))) prop_Diff2 :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_Diff2 xs ys = List.sort (keys ((\\) (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys))) {- prop_IntValid = forValidUnitTree $ \t1 -> forValidUnitTree $ \t2 -> valid (intersection t1 t2) -} prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_Int xs ys = List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) == List.sort (List.nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys))) {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} prop_Ordered = forAll (choose (5,100)) $ \n -> let xs = [(x,()) | x <- [0..n::Int]] in fromAscList xs == fromList xs prop_List :: [Int] -> Bool prop_List xs = (List.sort (List.nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])]) ------------------------------------------------------------------------ -- New tests: compare against the list model (after nub on keys) prop_index = \(xs :: [Int]) -> length xs > 0 ==> let m = fromList (zip xs xs) in xs == [ m ! i | i <- xs ] prop_null (m :: Data.IntMap.IntMap Int) = Data.IntMap.null m == (size m == 0) prop_member (xs :: [Int]) n = let m = fromList (zip xs xs) in (n `elem` xs) == (n `member` m) prop_notmember (xs :: [Int]) n = let m = fromList (zip xs xs) in (n `notElem` xs) == (n `notMember` m) prop_findWithDefault = \(ys :: [(Int, Int)]) -> length ys > 0 ==> let m = fromList xs xs = List.nubBy ((==) `on` fst) ys in and [ findWithDefault 0 i m == j | (i,j) <- xs ] -- prop_findIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==> -- let m = fromList ys -- in findIndex (fst (head ys)) m `seq` True -- prop_lookupIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==> -- let m = fromList ys -- in isJust (lookupIndex (fst (head ys)) m) prop_findMin = \(ys :: [(Int, Int)]) -> length ys > 0 ==> let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in findMin m == List.minimumBy (comparing fst) xs prop_findMax = \(ys :: [(Int, Int)]) -> length ys > 0 ==> let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in findMax m == List.maximumBy (comparing fst) xs prop_filter = \p (ys :: [(Int, Int)]) -> length ys > 0 ==> let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.filter p m == fromList (List.filter (p . snd) xs) prop_partition = \p (ys :: [(Int, Int)]) -> length ys > 0 ==> let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b) prop_map (f :: Int -> Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.map f m == fromList [ (a, f b) | (a,b) <- xs ] prop_fmap (f :: Int -> Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in fmap f m == fromList [ (a, f b) | (a,b) <- xs ] {- -- mapkeys is hard, as we have to consider collisions of the index space. prop_mapkeys (f :: Int -> Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.Map.mapKeys f m == (fromList $ {-List.nubBy ((==) `on` fst) $ reverse-} [ (f a, b) | (a,b) <- xs ]) -} {- prop_foldr (n :: Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in fold (+) n m == List.foldr (+) n (List.map snd xs) where fold k = Data.IntMap.foldrWithKey (\_ x' z' -> k x' z') -} {- prop_foldl (n :: Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.foldlWithKey (\a _ b -> a + b) n m == List.foldl (+) n (List.map snd xs) -} {- prop_foldl' (n :: Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.foldlWithKey' (\a _ b -> a + b) n m == List.foldl' (+) n (List.map snd xs) -} prop_fold (n :: Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.fold (+) n m == List.foldr (+) n (List.map snd xs) prop_foldWithKey (n :: Int) (ys :: [(Int, Int)]) = let m = fromList ys xs = List.nubBy ((==) `on` fst) (reverse ys) -- note. in Data.IntMap.foldWithKey (const (+)) n m == List.foldr (+) n (List.map snd xs) ------------------------------------------------------------------------ type UMap = Map () type IMap = Map Int type SMap = Map String ---------------------------------------------------------------- tests :: [Test] tests = [ testGroup "Test Case" [ -- testCase "ticket4242" test_ticket4242 testCase "index" test_index , testCase "size" test_size , testCase "size2" test_size2 , testCase "member" test_member , testCase "notMember" test_notMember , testCase "lookup" test_lookup , testCase "findWithDefault" test_findWithDefault , testCase "empty" test_empty , testCase "mempty" test_mempty , testCase "singleton" test_singleton , testCase "insert" test_insert , testCase "insertWith" test_insertWith -- , testCase "insertWith'" test_insertWith' -- , testCase "insertWithKey" test_insertWithKey -- , testCase "insertWithKey'" test_insertWithKey' , testCase "insertLookupWithKey" test_insertLookupWithKey -- , testCase "insertLookupWithKey'" test_insertLookupWithKey' , testCase "delete" test_delete , testCase "adjust" test_adjust , testCase "adjustWithKey" test_adjustWithKey , testCase "update" test_update , testCase "updateWithKey" test_updateWithKey , testCase "updateLookupWithKey" test_updateLookupWithKey , testCase "alter" test_alter , testCase "union" test_union , testCase "mappend" test_mappend , testCase "unionWith" test_unionWith , testCase "unionWithKey" test_unionWithKey , testCase "unions" test_unions , testCase "mconcat" test_mconcat , testCase "unionsWith" test_unionsWith , testCase "difference" test_difference , testCase "differenceWith" test_differenceWith , testCase "differenceWithKey" test_differenceWithKey , testCase "intersection" test_intersection , testCase "intersectionWith" test_intersectionWith , testCase "intersectionWithKey" test_intersectionWithKey , testCase "map" test_map , testCase "mapWithKey" test_mapWithKey , testCase "mapAccum" test_mapAccum , testCase "mapAccumWithKey" test_mapAccumWithKey , testCase "mapAccumRWithKey" test_mapAccumRWithKey -- , testCase "mapKeys" test_mapKeys -- , testCase "mapKeysWith" test_mapKeysWith -- , testCase "mapKeysMonotonic" test_mapKeysMonotonic , testCase "fold" test_fold , testCase "foldWithKey" test_foldWithKey , testCase "elems" test_elems , testCase "keys" test_keys , testCase "keysSet" test_keysSet , testCase "associative" test_assocs , testCase "toList" test_toList , testCase "fromList" test_fromList , testCase "fromListWith" test_fromListWith , testCase "fromListWithKey" test_fromListWithKey , testCase "toAscList" test_toAscList -- , testCase "toDescList" test_toDescList , testCase "showTree" test_showTree -- , testCase "showTree'" test_showTree' , testCase "fromAscList" test_fromAscList , testCase "fromAscListWith" test_fromAscListWith , testCase "fromAscListWithKey" test_fromAscListWithKey , testCase "fromDistinctAscList" test_fromDistinctAscList , testCase "filter" test_filter , testCase "filterWithKey" test_filteWithKey , testCase "partition" test_partition , testCase "partitionWithKey" test_partitionWithKey , testCase "mapMaybe" test_mapMaybe , testCase "mapMaybeWithKey" test_mapMaybeWithKey , testCase "mapEither" test_mapEither , testCase "mapEitherWithKey" test_mapEitherWithKey , testCase "split" test_split , testCase "splitLookup" test_splitLookup , testCase "isSubmapOfBy" test_isSubmapOfBy , testCase "isSubmapOf" test_isSubmapOf , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy , testCase "isProperSubmapOf" test_isProperSubmapOf -- , testCase "lookupIndex" test_lookupIndex -- , testCase "findIndex" test_findIndex -- , testCase "elemAt" test_elemAt -- , testCase "updateAt" test_updateAt -- , testCase "deleteAt" test_deleteAt , testCase "findMin" test_findMin , testCase "findMax" test_findMax , testCase "deleteMin" test_deleteMin , testCase "deleteMax" test_deleteMax -- , testCase "deleteFindMin" test_deleteFindMin -- , testCase "deleteFindMax" test_deleteFindMax -- , testCase "updateMin" test_updateMin -- , testCase "updateMax" test_updateMax -- , testCase "updateMinWithKey" test_updateMinWithKey -- , testCase "updateMaxWithKey" test_updateMaxWithKey , testCase "minView" test_minView , testCase "maxView" test_maxView , testCase "minViewWithKey" test_minViewWithKey , testCase "maxViewWithKey" test_maxViewWithKey -- , testCase "valid" test_valid ] , testGroup "Property Test" [ -- testProperty "fromList" prop_fromList testProperty "insert to singleton" prop_singleton -- , testProperty "insert" prop_insert , testProperty "insert then lookup" prop_lookup -- , testProperty "insert then delete" prop_insertDelete -- , testProperty "insert then delete2" prop_insertDelete2 , testProperty "delete non member" prop_deleteNonMember -- , testProperty "deleteMin" prop_deleteMin -- , testProperty "deleteMax" prop_deleteMax -- , testProperty "split" prop_split -- , testProperty "split then join" prop_join -- , testProperty "split then merge" prop_merge -- , testProperty "union" prop_union , testProperty "union model" prop_unionModel , testProperty "union singleton" prop_unionSingleton , testProperty "union associative" prop_unionAssoc , testProperty "fromAscList" prop_ordered , testProperty "fromList then toList" prop_list , testProperty "unionWith" prop_unionWith -- , testProperty "unionWith2" prop_unionWith2 , testProperty "union sum" prop_unionSum -- , testProperty "difference" prop_difference , testProperty "difference model" prop_differenceModel -- , testProperty "intersection" prop_intersection , testProperty "intersection model" prop_intersectionModel -- , testProperty "alter" prop_alter ] ] ---------------------------------------------------------------- -- Unit tests ---------------------------------------------------------------- -- test_ticket4242 :: Assertion -- test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True ---------------------------------------------------------------- -- Operators test_index :: Assertion test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a' ---------------------------------------------------------------- -- Query test_size :: Assertion test_size = do null (empty) @?= True null (singleton 1 'a') @?= False test_size2 :: Assertion test_size2 = do size empty @?= 0 size (singleton 1 'a') @?= 1 size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3 test_member :: Assertion test_member = do member 5 (fromList [(5,'a'), (3,'b')]) @?= True member 1 (fromList [(5,'a'), (3,'b')]) @?= False test_notMember :: Assertion test_notMember = do notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True test_lookup :: Assertion test_lookup = do employeeCurrency 1 @?= Just 1 employeeCurrency 2 @?= Nothing where employeeDept = fromList([(1,2), (3,1)]) deptCountry = fromList([(1,1), (2,2)]) countryCurrency = fromList([(1, 2), (2, 1)]) employeeCurrency :: Int -> Maybe Int employeeCurrency name = do dept <- lookup name employeeDept country <- lookup dept deptCountry lookup country countryCurrency test_findWithDefault :: Assertion test_findWithDefault = do findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x' findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a' ---------------------------------------------------------------- -- Construction test_empty :: Assertion test_empty = do (empty :: UMap) @?= fromList [] size empty @?= 0 test_mempty :: Assertion test_mempty = do (mempty :: UMap) @?= fromList [] size (mempty :: UMap) @?= 0 test_singleton :: Assertion test_singleton = do singleton 1 'a' @?= fromList [(1, 'a')] size (singleton 1 'a') @?= 1 test_insert :: Assertion test_insert = do insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')] insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')] insert 5 'x' empty @?= singleton 5 'x' test_insertWith :: Assertion test_insertWith = do insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")] insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")] insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx" -- test_insertWith' :: Assertion -- test_insertWith' = do -- insertWith' (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")] -- insertWith' (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")] -- insertWith' (++) 5 "xxx" empty @?= singleton 5 "xxx" -- test_insertWithKey :: Assertion -- test_insertWithKey = do -- insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")] -- insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")] -- insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx" -- where -- f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value -- test_insertWithKey' :: Assertion -- test_insertWithKey' = do -- insertWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")] -- insertWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")] -- insertWithKey' f 5 "xxx" empty @?= singleton 5 "xxx" -- where -- f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value test_insertLookupWithKey :: Assertion test_insertLookupWithKey = do insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")]) insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")]) insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")]) insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx") where f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value {- test_insertLookupWithKey' :: Assertion test_insertLookupWithKey' = do insertLookupWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")]) insertLookupWithKey' f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")]) insertLookupWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")]) insertLookupWithKey' f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx") where f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value -} ---------------------------------------------------------------- -- Delete/Update test_delete :: Assertion test_delete = do delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] delete 5 empty @?= (empty :: IMap) test_adjust :: Assertion test_adjust = do adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")] adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] adjust ("new " ++) 7 empty @?= empty test_adjustWithKey :: Assertion test_adjustWithKey = do adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")] adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] adjustWithKey f 7 empty @?= empty where f key x = (show key) ++ ":new " ++ x test_update :: Assertion test_update = do update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")] update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" where f x = if x == "a" then Just "new a" else Nothing test_updateWithKey :: Assertion test_updateWithKey = do updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")] updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" where f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing test_updateLookupWithKey :: Assertion test_updateLookupWithKey = do updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:new a")]) updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")]) updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a") where f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing test_alter :: Assertion test_alter = do alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")] alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")] alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")] where f _ = Nothing g _ = Just "c" ---------------------------------------------------------------- -- Combine test_union :: Assertion test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")] test_mappend :: Assertion test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")] test_unionWith :: Assertion test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")] test_unionWithKey :: Assertion test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")] where f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value test_unions :: Assertion test_unions = do unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] @?= fromList [(3, "b"), (5, "a"), (7, "C")] unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])] @?= fromList [(3, "B3"), (5, "A3"), (7, "C")] test_mconcat :: Assertion test_mconcat = do mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] @?= fromList [(3, "b"), (5, "a"), (7, "C")] mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])] @?= fromList [(3, "B3"), (5, "A3"), (7, "C")] test_unionsWith :: Assertion test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")] test_difference :: Assertion test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b" test_differenceWith :: Assertion test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")]) @?= singleton 3 "b:B" where f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing test_differenceWithKey :: Assertion test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")]) @?= singleton 3 "3:b|B" where f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing test_intersection :: Assertion test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a" test_intersectionWith :: Assertion test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA" test_intersectionWithKey :: Assertion test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A" where f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar ---------------------------------------------------------------- -- Traversal test_map :: Assertion test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")] test_mapWithKey :: Assertion test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")] where f key x = (show key) ++ ":" ++ x test_mapAccum :: Assertion test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")]) where f a b = (a ++ b, b ++ "X") test_mapAccumWithKey :: Assertion test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")]) where f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") test_mapAccumRWithKey :: Assertion test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")]) where f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") {- test_mapKeys :: Assertion test_mapKeys = do mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")] mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c" mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c" test_mapKeysWith :: Assertion test_mapKeysWith = do mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab" mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab" -} {- test_mapKeysMonotonic :: Assertion test_mapKeysMonotonic = do mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")] valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False -} test_fold :: Assertion test_fold = fold f 0 (fromList [(5,"a"), (3,"bbb")]) @?= 4 where f a len = len + (length a) test_foldWithKey :: Assertion test_foldWithKey = foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) @?= "Map: (5:a)(3:b)" where f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")" ---------------------------------------------------------------- -- Conversion test_elems :: Assertion test_elems = do elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"] elems (empty :: UMap) @?= [] test_keys :: Assertion test_keys = do keys (fromList [(5,"a"), (3,"b")]) @?= [3,5] keys (empty :: UMap) @?= [] test_keysSet :: Assertion test_keysSet = do keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.IntSet.fromList [3,5] keysSet (empty :: UMap) @?= Data.IntSet.empty test_assocs :: Assertion test_assocs = do assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")] assocs (empty :: UMap) @?= [] ---------------------------------------------------------------- -- Lists test_toList :: Assertion test_toList = do toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")] toList (empty :: SMap) @?= [] test_fromList :: Assertion test_fromList = do fromList [] @?= (empty :: SMap) fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")] fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")] test_fromListWith :: Assertion test_fromListWith = do fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")] fromListWith (++) [] @?= (empty :: SMap) test_fromListWithKey :: Assertion test_fromListWithKey = do fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")] fromListWithKey f [] @?= (empty :: SMap) where f k a1 a2 = (show k) ++ a1 ++ a2 ---------------------------------------------------------------- -- Ordered lists test_toAscList :: Assertion test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")] -- test_toDescList :: Assertion -- test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")] test_showTree :: Assertion test_showTree = (let t = fromDistinctAscList [(x,()) | x <- [1..5]] in showTree t) @?= "*\n+--*\n| +-- 1:=()\n| +--*\n| +-- 2:=()\n| +-- 3:=()\n+--*\n +-- 4:=()\n +-- 5:=()\n" {- test_showTree' :: Assertion test_showTree' = (let t = fromDistinctAscList [(x,()) | x <- [1..5]] in s t ) @?= "+--5:=()\n|\n4:=()\n|\n| +--3:=()\n| |\n+--2:=()\n |\n +--1:=()\n" where showElem k x = show k ++ ":=" ++ show x s = showTreeWith showElem False True -} test_fromAscList :: Assertion test_fromAscList = do fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")] fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")] -- valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True -- valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False test_fromAscListWith :: Assertion test_fromAscListWith = do fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")] -- valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True -- valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False test_fromAscListWithKey :: Assertion test_fromAscListWithKey = do fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")] -- valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True -- valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False where f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 test_fromDistinctAscList :: Assertion test_fromDistinctAscList = do fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")] -- valid (fromDistinctAscList [(3,"b"), (5,"a")]) @?= True -- valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False ---------------------------------------------------------------- -- Filter test_filter :: Assertion test_filter = do filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty test_filteWithKey :: Assertion test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" test_partition :: Assertion test_partition = do partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a") partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty) partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")]) test_partitionWithKey :: Assertion test_partitionWithKey = do partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b") partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty) partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")]) test_mapMaybe :: Assertion test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a" where f x = if x == "a" then Just "new a" else Nothing test_mapMaybeWithKey :: Assertion test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3" where f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing test_mapEither :: Assertion test_mapEither = do mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")]) @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")]) mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")]) @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")]) where f a = if a < "c" then Left a else Right a test_mapEitherWithKey :: Assertion test_mapEitherWithKey = do mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")]) @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")]) mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")]) @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")]) where f k a = if k < 5 then Left (k * 2) else Right (a ++ a) test_split :: Assertion test_split = do split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")]) split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a") split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a") split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty) split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty) test_splitLookup :: Assertion test_splitLookup = do splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")]) splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a") splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a") splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty) splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty) ---------------------------------------------------------------- -- Submap test_isSubmapOfBy :: Assertion test_isSubmapOfBy = do isSubmapOfBy (==) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True isSubmapOfBy (<=) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True isSubmapOfBy (==) (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False isSubmapOfBy (<) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False test_isSubmapOf :: Assertion test_isSubmapOf = do isSubmapOf (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True isSubmapOf (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False test_isProperSubmapOfBy :: Assertion test_isProperSubmapOfBy = do isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False test_isProperSubmapOf :: Assertion test_isProperSubmapOf = do isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False ---------------------------------------------------------------- -- Indexed {- test_lookupIndex :: Assertion test_lookupIndex = do isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")])) @?= False fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0 fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1 isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")])) @?= False -} -- test_findIndex :: Assertion -- test_findIndex = do -- findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0 -- findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1 -- test_elemAt :: Assertion -- test_elemAt = do -- elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b") -- elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a") -- test_updateAt :: Assertion -- test_updateAt = do -- updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")] -- updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")] -- updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" -- updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" -- test_deleteAt :: Assertion -- test_deleteAt = do -- deleteAt 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" -- deleteAt 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" ---------------------------------------------------------------- -- Min/Max test_findMin :: Assertion test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b") test_findMax :: Assertion test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a") test_deleteMin :: Assertion test_deleteMin = do deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")] -- deleteMin (empty :: SMap) @?= empty test_deleteMax :: Assertion test_deleteMax = do deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")] -- deleteMax (empty :: SMap) @?= empty -- test_deleteFindMin :: Assertion -- test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")]) -- test_deleteFindMax :: Assertion -- test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")]) -- test_updateMin :: Assertion ---- test_updateMin = do -- updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")] -- updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" -- test_updateMax :: Assertion -- test_updateMax = do -- updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")] -- updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" -- test_updateMinWithKey :: Assertion -- test_updateMinWithKey = do -- updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")] -- updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a" -- test_updateMaxWithKey :: Assertion -- test_updateMaxWithKey = do -- updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")] -- updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b" test_minView :: Assertion test_minView = do minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a") minView (empty :: SMap) @?= Nothing test_maxView :: Assertion test_maxView = do maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b") maxView (empty :: SMap) @?= Nothing test_minViewWithKey :: Assertion test_minViewWithKey = do minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a") minViewWithKey (empty :: SMap) @?= Nothing test_maxViewWithKey :: Assertion test_maxViewWithKey = do maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b") maxViewWithKey (empty :: SMap) @?= Nothing ---------------------------------------------------------------- -- Debug -- test_valid :: Assertion -- test_valid = do -- valid (fromAscList [(3,"b"), (5,"a")]) @?= True -- valid (fromAscList [(5,"a"), (3,"b")]) @?= False ---------------------------------------------------------------- -- QuickCheck ---------------------------------------------------------------- -- prop_fromList :: UMap -> Bool -- prop_fromList t = valid t prop_singleton :: Int -> Int -> Bool prop_singleton k x = insert k x empty == singleton k x -- prop_insert :: Int -> UMap -> Bool -- prop_insert k t = valid $ insert k () t prop_lookup :: Int -> UMap -> Bool prop_lookup k t = lookup k (insert k () t) /= Nothing -- prop_insertDelete :: Int -> UMap -> Bool -- prop_insertDelete k t = valid $ delete k (insert k () t) prop_insertDelete2 :: Int -> UMap -> Property prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t) prop_deleteNonMember :: Int -> UMap -> Property prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t) -- prop_deleteMin :: UMap -> Bool -- prop_deleteMin t = valid $ deleteMin $ deleteMin t -- prop_deleteMax :: UMap -> Bool -- prop_deleteMax t = valid $ deleteMax $ deleteMax t ---------------------------------------------------------------- -- prop_split :: Int -> UMap -> Property -- prop_split k t = (lookup k t /= Nothing) ==> let (r,l) = split k t -- in (valid r, valid l) == (True, True) -- prop_join :: Int -> UMap -> Bool -- prop_join k t = let (l,r) = split k t -- in valid (join k () l r) -- prop_merge :: Int -> UMap -> Bool -- prop_merge k t = let (l,r) = split k t -- in valid (merge l r) ---------------------------------------------------------------- -- prop_union :: UMap -> UMap -> Bool -- prop_union t1 t2 = valid (union t1 t2) prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_unionModel xs ys = sort (keys (union (fromList xs) (fromList ys))) == sort (nub (P.map fst xs ++ P.map fst ys)) prop_unionSingleton :: IMap -> Int -> Int -> Bool prop_unionSingleton t k x = union (singleton k x) t == insert k x t prop_unionAssoc :: IMap -> IMap -> IMap -> Bool prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 prop_unionWith :: IMap -> IMap -> Bool prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1) -- prop_unionWith2 :: IMap -> IMap -> Bool -- prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2) prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_unionSum xs ys = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys))) == (sum (P.map snd xs) + sum (P.map snd ys)) -- prop_difference :: IMap -> IMap -> Bool -- prop_difference t1 t2 = valid (difference t1 t2) prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_differenceModel xs ys = sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) == sort ((L.\\) (nub (P.map fst xs)) (nub (P.map fst ys))) -- prop_intersection :: IMap -> IMap -> Bool -- prop_intersection t1 t2 = valid (intersection t1 t2) prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool prop_intersectionModel xs ys = sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) == sort (nub ((L.intersect) (P.map fst xs) (P.map fst ys))) ---------------------------------------------------------------- prop_ordered :: Property prop_ordered = forAll (choose (5,100)) $ \n -> let xs = [(x,()) | x <- [0..n::Int]] in fromAscList xs == fromList xs prop_list :: [Int] -> Bool prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])]) ---------------------------------------------------------------- prop_alter :: UMap -> Int -> Bool prop_alter t k = {-balanced t' &&-} 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 t' = alter f k t f Nothing = Just () f (Just ()) = Nothing