Decimal-0.3.1: tests/Main.hs
module Main where
import Data.Decimal
import Data.Ratio
import Data.Word
import Test.HUnit
import Control.Applicative
import Test.QuickCheck
import qualified Test.QuickCheck.Property as P
import Test.Framework as TF (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)
instance (Integral i, Arbitrary i) => Arbitrary (DecimalRaw i) where
arbitrary = Decimal <$> arbitrary <*> arbitrary
-- arbitrary = do
-- e <- sized (\n -> resize (n `div` 10) arbitrary) :: Gen Int
-- m <- sized (\n -> resize (n * 10) arbitrary)
-- return $ Decimal (fromIntegral $ abs e) m
instance (Integral i, Arbitrary i) => CoArbitrary (DecimalRaw i) where
coarbitrary (Decimal e m) gen = variant (v:: Integer) gen
where v = fromIntegral e + fromIntegral m
-- | "read" is the inverse of "show".
--
-- > read (show n) == n
prop_readShow :: Decimal -> Bool
prop_readShow d = (read (show d)) == d
-- | Read and show preserve decimal places.
--
-- > decimalPlaces (read (show n)) == decimalPlaces n
prop_readShowPrecision :: Decimal -> Bool
prop_readShowPrecision d = decimalPlaces (read (show d) :: Decimal)
== decimalPlaces d
-- | "fromInteger" definition.
--
-- > decimalPlaces (fromInteger n) == 0 &&
-- > decimalMantissa (fromInteger n) == n
prop_fromIntegerZero :: Integer -> Bool
prop_fromIntegerZero n = decimalPlaces (fromInteger n :: Decimal) == 0 &&
decimalMantissa (fromInteger n :: Decimal) == n
-- | Increased precision does not affect equality.
--
-- > decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d
prop_increaseDecimals :: Decimal -> Property
prop_increaseDecimals d =
decimalPlaces d < maxBound ==> roundTo (decimalPlaces d + 1) d == d
-- | Decreased precision can make two decimals equal, but it can never change
-- their order.
--
-- > forAll d1, d2 :: Decimal -> legal beforeRound afterRound
-- > where
-- > beforeRound = compare d1 d2
-- > afterRound = compare (roundTo 0 d1) (roundTo 0 d2)
-- > legal GT x = x `elem` [GT, EQ]
-- > legal EQ x = x `elem` [EQ]
-- > legal LT x = x `elem` [LT, EQ]
prop_decreaseDecimals :: Decimal -> Decimal -> Bool
prop_decreaseDecimals d1 d2 = legal beforeRound afterRound
where
beforeRound = compare d1 d2
afterRound = compare (roundTo 0 d1) (roundTo 0 d2)
legal GT x = x `elem` [GT, EQ]
legal EQ x = x `elem` [EQ]
legal LT x = x `elem` [LT, EQ]
-- | > (x + y) - y == x
prop_inverseAdd :: Decimal -> Decimal -> Bool
prop_inverseAdd x y = (x + y) - y == x
-- | Multiplication is repeated addition.
--
-- > forall d, NonNegative i : (sum $ replicate i d) == d * fromIntegral (max i 0)
prop_repeatedAdd :: Decimal -> Word8 -> Bool
prop_repeatedAdd d i = (sum $ replicate (fromIntegral i) d) == d * fromIntegral (max i 0)
-- | Division produces the right number of parts.
--
-- > forall d, Positive i : (sum $ map fst $ divide d i) == i
prop_divisionParts :: Decimal -> Positive Int -> Property
prop_divisionParts d (Positive i) = i > 0 ==> (sum $ map fst $ divide d i) == i
-- | Division doesn't drop any units.
--
-- > forall d, Positive i : (sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d
prop_divisionUnits :: Decimal -> Positive Int -> Bool
prop_divisionUnits d (Positive i) =
(sum $ map (\(n,d1) -> fromIntegral n * d1) $ divide d i) == d
-- | Allocate produces the right number of parts.
--
-- > sum ps /= 0 ==> length ps == length (allocate d ps)
prop_allocateParts :: Decimal -> [Integer] -> Property
prop_allocateParts d ps =
sum ps /= 0 ==> length ps == length (allocate d ps)
-- | Allocate doesn't drop any units.
--
-- > sum ps /= 0 ==> sum (allocate d ps) == d
prop_allocateUnits :: Decimal -> [Integer] -> Property
prop_allocateUnits d ps =
sum ps /= 0 ==> sum (allocate d ps) == d
-- | Absolute value definition
--
-- > decimalPlaces a == decimalPlaces d &&
-- > decimalMantissa a == abs (decimalMantissa d)
-- > where a = abs d
prop_abs :: Decimal -> Bool
prop_abs d = decimalPlaces a == decimalPlaces d &&
decimalMantissa a == abs (decimalMantissa d)
where a = abs d
-- | Sign number defintion
--
-- > signum d == (fromInteger $ signum $ decimalMantissa d)
prop_signum :: Decimal -> Bool
prop_signum d = signum d == (fromInteger $ signum $ decimalMantissa d)
-- | The addition is valid
prop_sumValid :: Decimal -> Decimal -> Property
prop_sumValid a b = (decimalPlaces a < maxBound && decimalPlaces b < maxBound) ==>
(toRational (a + b) == (toRational a) + (toRational b))
prop_mulValid :: Decimal -> Decimal -> Property
prop_mulValid a b = ((ad + bd) < fromIntegral (maxBound :: Word8)) ==>
(toRational (a * b) == (toRational a) * (toRational b))
where
ad :: Integer
ad = fromIntegral $ decimalPlaces a
bd = fromIntegral $ decimalPlaces b
prop_eitherFromRational :: Decimal -> Bool
prop_eitherFromRational d = (Right d) == (eitherFromRational $ toRational d)
prop_normalizeDecimal :: Decimal -> Bool
prop_normalizeDecimal d = d == (normalizeDecimal d)
-- | Division is the inverted multiplication
prop_divisionMultiplication :: Decimal -> Decimal -> Property
prop_divisionMultiplication a b = ((ad + bd) < fromIntegral (maxBound :: Word8) && a /= 0 && b /= 0) ==>
(c / a == b) .&&. (c / b == a)
where
ad :: Integer
ad = fromIntegral $ decimalPlaces a
bd = fromIntegral $ decimalPlaces b
c = a * b
prop_fromRational :: Decimal -> Bool
prop_fromRational a = a == (fromRational $ toRational a)
prop_properFraction :: Decimal -> Bool
prop_properFraction a = a == (fromIntegral b + d)
where
b :: Integer
(b, d) = properFraction a
main :: IO ()
main = defaultMain tests
-- Monomorphic variations on polymorphic themes to avoid type default warnings.
dec :: Word8 -> Integer -> Decimal
dec = Decimal
dec1 :: Word8 -> Int -> DecimalRaw Int
dec1 = Decimal
piD :: Double
piD = pi
tests :: [TF.Test]
tests = [
testGroup "QuickCheck Data.Decimal" [
testProperty "readShow" prop_readShow,
testProperty "readShowPrecision" prop_readShowPrecision,
testProperty "fromIntegerZero" prop_fromIntegerZero,
testProperty "increaseDecimals" prop_increaseDecimals,
testProperty "decreaseDecimals" prop_decreaseDecimals,
testProperty "inverseAdd" prop_inverseAdd,
testProperty "repeatedAdd" prop_repeatedAdd,
testProperty "divisionParts" prop_divisionParts,
testProperty "divisionUnits" prop_divisionUnits,
testProperty "allocateParts" prop_allocateParts,
testProperty "allocateUnits" prop_allocateUnits,
testProperty "abs" prop_abs,
testProperty "signum" prop_signum,
testProperty "sumvalid" prop_sumValid,
testProperty "mulValid" prop_mulValid,
testProperty "eitherFromRational" prop_eitherFromRational,
testProperty "normalizeDecimal" prop_normalizeDecimal,
testProperty "divisionMultiplication" prop_divisionMultiplication,
testProperty "fromRational" prop_fromRational,
testProperty "properFraction" prop_properFraction
],
testGroup "Point tests Data.Decimal" [
testCase "pi to 3dp" (dec 3 3142 @=? realFracToDecimal 3 piD),
testCase "pi to 2dp" (dec 2 314 @=? realFracToDecimal 2 piD),
testCase "100*pi to 2dp" (dec 2 31416 @=? realFracToDecimal 2 (100 * piD)),
testCase "1.0 * pi" (dec 1 31 @=? dec 1 10 *. piD),
testCase "1.23 * pi" (dec 2 386 @=? dec 2 123 *. piD),
testCase "Decimal to DecimalRaw Int"
(decimalConvert (dec 2 123) @=? dec1 2 123),
testCase "1.234 to rational" (1234 % 1000 @=? (toRational (dec 3 1234)))
]
]