Tests.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Data.Bits
import Data.Vector.Bit
import qualified Data.Vector.Unboxed as V

import Test.Tasty
import Test.Tasty.TH
import Test.Tasty.QuickCheck hiding ((.&.))

instance Arbitrary BitVector where
  arbitrary = (unpackInteger . getNonNegative) `fmap` arbitrary

prop_packUnpack :: Int -> Bool
prop_packUnpack x | x >= 0 = pack (unpack x) == x
                  | otherwise = True

prop_unpackPack :: [Bool] -> Bool
prop_unpackPack xs
    | length xs < 64 && (pack (V.fromList xs') :: Int) >= 0
    = unpack (pack (V.fromList xs') :: Int) == V.fromList xs'
    | otherwise = True
  where xs' = reverse . dropWhile not . reverse $ xs

prop_addCorrect :: Int -> Int -> Bool
prop_addCorrect x y = x + y == pack (unpack x + unpack y)

prop_multCorrect :: Int -> Int -> Bool
prop_multCorrect x y = x * y == pack (unpack x * unpack y)

prop_subCorrect :: Int -> Int -> Bool
prop_subCorrect x y | x >= y = x - y == pack (unpack x - unpack y)
                    | otherwise = True

prop_absSignum :: Int -> Bool
prop_absSignum x | x >= 0 = abs (unpack x) * signum (unpack x) == unpack x
                 | otherwise = True

prop_clearZero :: NonNegative Int -> Bool
prop_clearZero nn = clearBit zeroBits n ==~ zeroBits
  where n = getNonNegative nn

prop_setZero :: NonNegative Int -> Bool
prop_setZero nn = setBit zeroBits n ==~ bit n
  where n = getNonNegative nn

prop_testZero :: NonNegative Int -> Bool
prop_testZero nn = testBit (zeroBits :: BitVector) n == False
  where n = getNonNegative nn

prop_countZero :: Bool
prop_countZero = popCount (zeroBits :: BitVector) == 0

prop_complementInverse :: BitVector -> Bool
prop_complementInverse v = complement (complement v) ==~ v

prop_orSet :: BitVector -> NonNegative Int -> Bool
prop_orSet v nn = testBit (v .|. bit n) n
  where n = getNonNegative nn

prop_andTest :: BitVector -> NonNegative Int -> Bool
prop_andTest v nn = testBit v n == not (v .&. bit n ==~ zeroBits)
  where n = getNonNegative nn

prop_andClear :: BitVector -> NonNegative Int -> Bool
prop_andClear v nn = clearBit v n ==~ v' .&. complement mask
  where n          = getNonNegative nn
        (v', mask) = padMax v (bit n)

prop_xorZero :: BitVector -> Bool
prop_xorZero v = v `xor` v ==~ zeroBits

prop_xorFlip :: BitVector -> NonNegative Int -> Bool
prop_xorFlip v nn = testBit v' n == not (testBit v n)
  where v' = v `xor` bit n
        n  = getNonNegative nn

main = $(defaultMainGenerator)