-- | Tests for blobs
{-# LANGUAGE CPP,BangPatterns #-}
module Tests.Blob where
--------------------------------------------------------------------------------
import Data.Bits
import Data.Word
import Data.List as L
import Data.Primitive.ByteArray
import Data.Vector.Compact.Blob as B
import Test.Tasty
import Test.Tasty.HUnit
--------------------------------------------------------------------------------
-- | An alternate implementation using 'testBit', for testing purposes only
extractSmallWord64_naive :: Int -> Blob -> Int -> Word64
extractSmallWord64_naive n blob ofs = sum [ shiftL 1 i | i<-[0..n-1] , testBit blob (ofs+i) ]
--------------------------------------------------------------------------------
all_tests = tests_blobs
tests_blobs = testGroup "unit tests for Blobs"
[ testCase "toList . fromList == id" $ forall_ w64_lists prop_from_to_list
, testCase "fromList . toList == id" $ forall_ blobs prop_to_from_blob
, testCase "toList vs. peekWord" $ forall_ blobs prop_tolist_vs_peek
, testCase "blobHead vs. list head" $ forall_ w64_lists prop_head_of_list
, testCase "eqBlob vs. naive" $ forall_ blob_pairs prop_eq_vs_naive
, testCase "fromBA . toBA == id" $ forall_ blobs prop_to_from_bytearray
, testCase "toBA . fromBA == pad" $ forall_ byte_lists prop_from_to_bytearray
--
, testCase "tail . cons == id" $ forall_ blobs prop_tail_cons
--
, testCase "rotateL . rotateR == id" $ forall_ blobs prop_rotateL_rotateR
, testCase "rotateR . rotateL == id" $ forall_ blobs prop_rotateR_rotateL
, testCase "rotateL [1]" $ forall_ [0..130] prop_rotateL_one
, testCase "rotateR [1]" $ forall_ [0..130] prop_rotateR_one
, testCase "rotateL [1,0,0]" $ forall_ [0..530] prop_rotateL_one_blob3
, testCase "rotateR [0,0,z]" $ forall_ [0..530] prop_rotateR_one_blob3
--
, testCase "shiftR_64 . shiftL_64 == id" $ forall_ blobs prop_shiftR64_shiftL64
, testCase "shiftL_64 . shiftR_64 = ..." $ forall_ blobs prop_shiftL64_shiftR64
, testCase "shiftR 64 == tail" $ forall_ blobs prop_shiftR64_is_tail
, testCase "shiftR . shiftL ~= id" $ forall_ blobs prop_shiftR_shiftL
, testCase "shiftL [1]" $ forall_ [0..530] prop_shiftL_one
]
forall_ :: [a] -> (a -> Bool) -> Assertion
forall_ xs cond = assertBool "failed" (and (map cond xs))
--------------------------------------------------------------------------------
-- * inputs
w1,w2 :: Word64
w1 = 0x1234567890abcdef
w2 = 0xefcdab9078563412
rndWords1, rndWords2 :: [Word64]
rndWords1 =
[0x636bab7ce12a9f82,0xacb1651d835dea8a,0x53ee90f119788b9c,0xb3e5f34f1a7b14df,0x108afb5d5ef5420b
,0xad8a4492183b5890,0x29338ff97c3c4b30,0xab38a94da16f8831,0x3eebedc58090704f,0xfb0de19c60305cfc
,0xe1f9cc292fd9fd99,0x661cbeb165fc5369,0x45b9557954fa8197,0x5999769d181a0e58,0xbbbc1a04bf66f1a7
,0x8b14a985d9e28575,0xa59e5b55e5bd190f,0xc86dcfa51ec3f984,0x8ada7c8b2a057cc2,0x38085a65b744237d
,0xcaf0303da21ecc16,0xc660be5561054445,0xeaf4360fc8aa9031,0xd60926fff096d2ab,0x1a03ac007c232799
,0xe584496fb0608fc0,0x09079c518d7206e3,0x4c5a70bebce35d84,0xf8200f7b4dae3d6a,0xb4a6c4c4b5d16a38
,0x5451bc4e7fb2cfeb,0x6525fd92075937b6,0x406eae19f78ec53e,0x6bf94e6694a523ec,0xfeb03e90e7faba04
,0xf10a0d43f2c28d4b,0xe44aa8f952a71ce4,0x6ef966e88c95e8cc,0x1f0a91de603823fe,0x540fc5e2212688c5
,0x98538a3191aa00c4,0x82a866243999920b,0x7c531773ea9a576e,0x683e1d213a11048e,0x001441c42aea5812
,0x278d5e7726567c30,0xe0af4e322898ba88,0x6693727353fd7cb0,0x87fc50f2604236e4,0x888c720e479ba9ba
,0x9aad9422fa1cd5ce,0x77b7d3c79b10764a,0x693f8172f63598a7,0x61daefcdebed2f6e,0x999306f3808e557e
,0x5d58c9725e45aed4,0x56aa23006a204e29,0x7b9f38d5f920cb7b,0xd1a79fbb76b795d0,0xe268fbe17c6672d3
,0xb8d8989b3d3dba70,0xa12c3645bb8cdf93,0x732cb315500e9ff6,0x45614a09f768ab04,0xd7a44a81f4a4626d
]
rndWords2 =
[0x888efd3a8e9d3d0f,0x3f7c8015929c4d0b,0x9dd1576dfee9144d,0x706e50d93edb988f,0x1bf0fbd22cb2fe42
,0xea3cb4e94f17df4a,0xf24bc3fb3eb11658,0xfdafd48ff4a6560e,0xf3fb721e97c24e28,0xe4189f3b29bab63c
,0x9888e3eed7a10abe,0x3f655e3ac3f99dfe,0xbdaf179b0ab70e1b,0x933489e815343e8d,0xc552296865200a2b
,0x0d7ee80f467eeb04,0xfd6b778e8babe925,0x1bb1255de3cd8786,0xc4a3b6f573ec6af1,0xd2dbf7d5b6a3be2e
,0xa1e22b70a36c96f8,0xa617f27f72fe8ff2,0x1e5024e9159ff0ae,0x603f5a9c50986495,0xe2f17131fb59bd93
,0x8d01a921a59646b7,0xc85ae16a975b9e97,0x3ff90c245b9ad063,0x4889782b52890c9f,0xa79b24111b5558d9
,0x9bc09895641cdd04,0xda8a2359ad7d0335,0x4e925260435f69a0,0x28fd2829993ee9b7,0xb38af0536c569fee
,0x78462beafef9e57c,0x2613166891ab270e,0x13775c45b6efb6c4,0x69921e49759bdda0,0x68bfc6f1643ff245
,0xf7dcc717f0549f2d,0x423e6b5bbfa2a8b6,0x5555fe6cc05d5519,0xc90f85f121c6adf0,0x68ec14dc41c1174d
,0x231473484795b255,0xa13c37dfbf1bfc44,0x5e3831b09836a34b,0x93fb41b63eedc8f8,0x07b3f59a37165884
,0x0b760cb359a1b6af,0x478b77fb0f54786e,0x024b1a3ddc880e54,0x3d565cd1272a3d81,0x9984a2d9ab5a4741
,0x8234b289e02f7aec,0x24e65cdf39319ded,0x7d3fd5f3b4f6b5a2,0x9289ff5cc281dcbd,0xb189bc7fee3c6c7c
,0x14f628aa402b4ab0,0x9dbe78e5f46e9e33,0xe2eeee94e9b874c3,0x6c236ec875b93341,0xf0429b07692c691b
]
{-
-- generate random words
import Data.List ; import Control.Monad ; import System.Random ; import Data.Word ; import Text.Printf
main = do
list <- replicateM 65 randomIO :: IO [Word64]
putStrLn $ "[" ++ intercalate "," (map (printf "0x%016x") list) ++ "]"
-}
--------------------------------------------------------------------------------
w64_lists_of_length :: Int -> [[Word64]]
w64_lists_of_length ni =
[ [ i | i<-[1..n] ]
, [ i | i<-[1001+n,1000+n .. 1001] ]
, [ i | i<-[2^32-1-n .. 2^32-1 ] ]
, [ i | i<-[2^32-1 .. 2^32+n-2 ] ]
, [ i | i<-[2^64-1-n .. 2^64-1 ] ]
, take ni rndWords1
, take ni rndWords2
, take ni $ reverse rndWords1
, take ni $ reverse rndWords2
]
where
n = fromIntegral ni :: Word64
w64_lists = concatMap w64_lists_of_length [1..33] :: [[Word64]]
blobs = map blobFromWordList w64_lists :: [Blob]
blob_pairs = [ (b1,b2)| b1<-blobs, b2<-blobs ] :: [(Blob,Blob)]
byte_lists = [ map fromIntegral [1..n] | n<-[1..(512::Int)] ] :: [[Word8]]
--------------------------------------------------------------------------------
eqBlob_naive b1 b2 = blobToWordList b1 == blobToWordList b2
baToByteList :: ByteArray -> [Word8]
baToByteList = foldrByteArray (:) []
pad :: [Word8] -> [Word8]
pad xs = xs ++ replicate (len8-len) 0 where
len = length xs
len8 = 8 * (div (len+7) 8)
local_longZipWith :: Integral a => (a -> a -> b) -> [a] -> [a] -> [b]
local_longZipWith f (x:xs) (y:ys) = f x y : local_longZipWith f xs ys
local_longZipWith f xs [] = zipWith f xs (repeat 0)
local_longZipWith f [] ys = zipWith f (repeat 0) ys
eqWithZeros :: Blob -> Blob -> Bool
eqWithZeros a b = and $ local_longZipWith (==) (blobToWordList a) (blobToWordList b)
--------------------------------------------------------------------------------
-- * properties
prop_from_to_list list = blobToWordList (blobFromWordList list) == list
prop_to_from_blob blob = blobFromWordList (blobToWordList blob) == blob
prop_tolist_vs_peek blob = [ B.indexWord blob i | i<-[0..n-1] ] == blobToWordList blob where
n = blobSizeInWords blob
prop_head_of_list list = B.head (blobFromWordList list) == L.head list
prop_eq_vs_naive (b1,b2) = eqBlob b1 b2 == eqBlob_naive b1 b2
prop_to_from_bytearray blob = blobFromByteArray (blobToByteArray blob) == blob
prop_from_to_bytearray list = baToByteList (blobToByteArray (blobFromByteArray ba)) == pad list where
ba = byteArrayFromList list
--------------------------------------------------------------------------------
prop_tail_cons blob = B.tail (B.consWord 0x1234567890abcdef blob) == blob
prop_shiftR64_is_tail blob = (shiftR blob 64) == B.tail blob
prop_shiftR64_shiftL64 blob = shiftR (shiftL blob 64) 64 == blob
prop_shiftL64_shiftR64 blob = shiftL (shiftR blob 64) 64 == B.consWord 0 (B.tail blob)
prop_shiftR_shiftL blob = and [ shiftR (shiftL blob i) i `eqWithZeros` blob | i<-[0..201] ]
prop_rotateL_rotateR blob = and [ rotateL (rotateR blob i) i == blob | i<-[0..201] ]
prop_rotateR_rotateL blob = and [ rotateR (rotateL blob i) i == blob | i<-[0..201] ]
prop_rotateL_one i = rotateL (Blob1 1) i == Blob1 (rotateL 1 i)
prop_rotateR_one i = rotateR (Blob1 1) i == Blob1 (rotateR 1 i)
prop_rotateL_one_blob3 i = x == y where
x = blobToWordList $ rotateL (blobFromWordList [1,0,0]) i
y = case divMod i 64 of
(q0,r) -> case (mod q0 3, r) of
(0,r) -> [ shiftL 1 r , 0 , 0 ]
(1,r) -> [ 0 , shiftL 1 r , 0 ]
(2,r) -> [ 0 , 0 , shiftL 1 r ]
prop_rotateR_one_blob3 i = x == y where
x = blobToWordList $ rotateR (blobFromWordList [0,0,z]) i
z = shiftL 1 63
y = case divMod i 64 of
(q0,r) -> case (mod q0 3, r) of
(0,r) -> [ 0 , 0 , shiftR z r ]
(1,r) -> [ 0 , shiftR z r , 0 ]
(2,r) -> [ shiftR z r , 0 , 0 ]
prop_shiftL_one i = x == y where
x = blobToWordList $ shiftL (Blob1 1) i
y = case divMod i 64 of
(q,r) -> replicate q 0 ++ [shiftL 1 r]
--------------------------------------------------------------------------------