-- | Tests for dynamic int vectors {-# LANGUAGE CPP,BangPatterns #-} module Tests.IntVec where -------------------------------------------------------------------------------- import Control.Monad ( liftM ) import Data.Int import qualified Data.List as L import Data.Vector.Compact.IntVec as V import Test.Tasty import Test.Tasty.HUnit #ifdef x86_64_HOST_ARCH arch_bits = 64 #elif i386_HOST_ARCH arch_bits = 32 #else arch_bits = 32 #endif -------------------------------------------------------------------------------- -- | For testing purposes only uncons_naive :: IntVec -> Maybe (Int,IntVec) uncons_naive vec = if V.null vec then Nothing else Just (V.head vec, V.tail vec) -------------------------------------------------------------------------------- all_tests = testGroup "unit tests for IntVec-s" [ tests_unit , tests_small , tests_bighead ] tests_unit = testGroup "misc unit tests" [ testCase "equality with different bit sizes" $ assertBool "failed" $ check_eq_bitsizes , testCase "head of empty == 0" $ assertBool "failed" $ (V.head V.empty == 0) , testCase "last of empty == 0" $ assertBool "failed" $ (V.last V.empty == 0) , testCase "tail of empty == empty" $ assertBool "failed" $ (V.tail V.empty == V.empty) ] tests_small = testGroup "unit tests for small dynamic int vectors" [ testCase "toList . fromList == id" $ forall_ small_Lists prop_from_to_list , testCase "fromList . toList == id" $ forall_ small_Vecs prop_to_from_vec , testCase "fromList vs. indexing" $ forall_ small_Lists prop_fromlist_vs_index , testCase "toRevList == reverse . toList" $ forall_ small_Vecs prop_toRevList , testCase "vec head vs. list head" $ forall_ small_NELists prop_head_of_list , testCase "vec last vs. list last" $ forall_ small_NELists prop_last_of_list , testCase "head vs. indexing" $ forall_ small_NEVecs prop_head_vs_index , testCase "cons . uncons == id" $ forall_ small_NEVecs prop_cons_uncons , testCase "uncons . cons == id" $ forall_ small_cons prop_uncons_cons , testCase "uncons vs. naive" $ forall_ small_Vecs prop_uncons_vs_naive , testCase "uncons vs. list" $ forall_ small_Vecs prop_uncons_vs_list , testCase "cons vs. list" $ forall_ small_cons prop_cons_vs_list ] tests_bighead = testGroup "unit tests for small dynamic int vectors with big heads" [ testCase "toList . fromList == id" $ forall_ bighead_Lists prop_from_to_list , testCase "fromList . toList == id" $ forall_ bighead_Vecs prop_to_from_vec , testCase "fromList vs. indexing" $ forall_ bighead_Lists prop_fromlist_vs_index , testCase "toRevList == reverse . toList" $ forall_ bighead_Vecs prop_toRevList , testCase "vec head vs. list head" $ forall_ bighead_NELists prop_head_of_list , testCase "vec last vs. list last" $ forall_ bighead_NELists prop_last_of_list , testCase "head vs. indexing" $ forall_ bighead_NEVecs prop_head_vs_index , testCase "cons . uncons == id" $ forall_ bighead_NEVecs prop_cons_uncons , testCase "uncons . cons == id" $ forall_ bighead_cons prop_uncons_cons , testCase "uncons vs. naive" $ forall_ bighead_Vecs prop_uncons_vs_naive , testCase "uncons vs. list" $ forall_ bighead_Vecs prop_uncons_vs_list , testCase "cons vs. list" $ forall_ bighead_cons prop_cons_vs_list ] forall_ :: [a] -> (a -> Bool) -> Assertion forall_ xs cond = assertBool "failed" (and (map cond xs)) -------------------------------------------------------------------------------- -- * inputs newtype List = List [Int] deriving Show newtype NEList = NEList [Int] deriving Show newtype Vec = Vec IntVec deriving Show newtype NEVec = NEVec IntVec deriving Show small_Lists :: [List] small_Lists = List [] : [ List xs | NEList xs <- small_NELists ] small_NELists :: [NEList] small_NELists = [ NEList [ofs..ofs+len-1] | ofs<-[-25..25] , len<-[1..65] ] small_Vecs :: [Vec] small_Vecs = [ Vec (V.fromList xs) | List xs <- small_Lists ] small_NEVecs :: [NEVec] small_NEVecs = [ NEVec (V.fromList xs) | NEList xs <- small_NELists ] small_cons :: [(Int,Vec)] small_cons = [ (x, Vec (V.fromList xs)) | NEList (x:xs) <- small_NELists ] -------------------------------------------------------------------------------- add_bighead :: List -> [List] add_bighead (List xs) = [ List (-2^k-1 : xs) | k<-[1..arch_bits-1] ] ++ [ List (-2^k : xs) | k<-[1..arch_bits-1] ] ++ [ List (-2^k+1 : xs) | k<-[1..arch_bits-1] ] ++ [ List ( 2^k-1 : xs) | k<-[1..arch_bits-1] ] ++ [ List ( 2^k : xs) | k<-[1..arch_bits-1] ] ++ [ List ( 2^k+1 : xs) | k<-[1..arch_bits-1] ] bighead_Lists = concatMap add_bighead small_Lists :: [List] bighead_Vecs = [ Vec (V.fromList xs) | List xs <- bighead_Lists ] :: [Vec] bighead_NELists = [ NEList xs | List xs <- bighead_Lists ] :: [NEList] bighead_NEVecs = [ NEVec v | Vec v <- bighead_Vecs ] :: [NEVec] bighead_cons = [ (x, Vec (V.fromList xs)) | NEList (x:xs) <- bighead_NELists ] -------------------------------------------------------------------------------- check_eq_bitsizes = and [ V.fromList [k] == V.fromList' (1,(-2^b,2^b)) [k] | k<-[-16..15] , b<-[4..31] ] -------------------------------------------------------------------------------- -- * properties prop_from_to_list (List list) = V.toList (V.fromList list) == list prop_to_from_vec (Vec vec ) = V.fromList (V.toList vec ) == vec prop_fromlist_vs_index (List list) = [ unsafeIndex i vec | i<-[0..n-1] ] == list where vec = V.fromList list n = V.vecLen vec prop_toRevList (Vec vec) = V.toRevList vec == reverse (V.toList vec) prop_head_of_list (NEList list) = V.head (V.fromList list) == L.head list prop_last_of_list (NEList list) = V.last (V.fromList list) == L.last list prop_head_vs_index (NEVec vec ) = V.head vec == unsafeIndex 0 vec prop_cons_uncons (NEVec vec) = liftM (uncurry V.cons) (V.uncons vec) == Just vec prop_uncons_cons (w,Vec vec) = V.uncons (V.cons w vec) == Just (w,vec) prop_uncons_vs_naive (Vec vec) = V.uncons vec == uncons_naive vec prop_uncons_vs_list (Vec vec) = unconsToList (V.uncons vec) == L.uncons (V.toList vec) prop_cons_vs_list (w,Vec vec) = V.toList (V.cons w vec) == w : (V.toList vec) unconsToList mb = case mb of Nothing -> Nothing Just (i,vec) -> Just (i, V.toList vec) --------------------------------------------------------------------------------