numtype-dk-0.5: Numeric/NumType/DKTests.hs
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
module Numeric.NumType.DKTests where
import Numeric.NumType.DK.Integers
import Prelude hiding ((*), (/), (+), (-), (^), pred, succ, negate, abs, signum)
import qualified Prelude as P ((*), (/), (+), (-), (^), pred, succ, negate, abs, signum)
import Data.Proxy
import Test.HUnit
-- Some “large” NumTypes.
neg12 = pred neg11
neg11 = pred neg10
neg10 = pred neg9
pos10 = succ pos9
pos11 = succ pos10
pos12 = succ pos11
-- | Compares a type level unary function with a value level unary function
-- by converting 'NumType' to a @Num@. This assumes that the 'toNum'
-- function is solid.
unaryTest :: (KnownNumType i, KnownNumType i', Num a, Eq a, Show a)
=> (Proxy i -> Proxy i') -> (a -> a) -> Proxy i -> Test
unaryTest f f' x = TestCase $ assertEqual
"Unary function Num equivalence"
(f' (toNum x)) (toNum (f x))
-- | 'unaryTest' with @Num a@ fixed to @Integer@. This is needed by
-- 'testIncrDecr'.
unaryTest' :: (KnownNumType i, KnownNumType i')
=> (Proxy i -> Proxy i') -> (Integer -> Integer) -> Proxy i -> Test
unaryTest' = unaryTest
-- | Compares a type level binary function with a value level binary function
-- by converting 'NumType' to 'Num'. This assumes that the 'toNum'
-- function is solid.
binaryTest :: (KnownNumType i, KnownNumType i', KnownNumType i'', Num a, Eq a, Show a)
=> (Proxy i -> Proxy i' -> Proxy i'')
-> (a -> a -> a)
-> Proxy i -> Proxy i' -> Test
binaryTest f f' x y = TestCase $ assertEqual
"Binary function Num equivalence"
(f' (toNum x) (toNum y)) (toNum (f x y))
binaryTest' :: (KnownNumType i, KnownNumType i', KnownNumType i'', Num a, Eq a, Show a)
=> (Proxy i -> Proxy i' -> Proxy i'')
-> (Integer -> Integer -> Integer)
-> Proxy i -> Proxy i' -> Test
binaryTest' = binaryTest
-- | Test that conversion to 'Num a' works as expected. This is sort of a
-- prerequisite for the other tests.
testAsIntegral = TestLabel "Num equivalence tests" $ TestList
[ TestCase $ -12 @=? toNum neg12
, TestCase $ -11 @=? toNum neg11
, TestCase $ -10 @=? toNum neg10
, TestCase $ -9 @=? toNum neg9
, TestCase $ -8 @=? toNum neg8
, TestCase $ -7 @=? toNum neg7
, TestCase $ -6 @=? toNum neg6
, TestCase $ -5 @=? toNum neg5
, TestCase $ -4 @=? toNum neg4
, TestCase $ -3 @=? toNum neg3
, TestCase $ -2 @=? toNum neg2
, TestCase $ -1 @=? toNum neg1
, TestCase $ 0 @=? toNum zero
, TestCase $ 1 @=? toNum pos1
, TestCase $ 2 @=? toNum pos2
, TestCase $ 3 @=? toNum pos3
, TestCase $ 4 @=? toNum pos4
, TestCase $ 5 @=? toNum pos5
, TestCase $ 6 @=? toNum pos6
, TestCase $ 7 @=? toNum pos7
, TestCase $ 8 @=? toNum pos8
, TestCase $ 9 @=? toNum pos9
, TestCase $ 10 @=? toNum pos10
, TestCase $ 11 @=? toNum pos11
, TestCase $ 12 @=? toNum pos12
] -- By induction all other NumTypes should be good if these are.
-- | Test incrementing and decrementing.
testIncrDecr = TestLabel "Increment and decrement tests" $ TestList
[ t neg12
, t neg11
, t neg10
, t neg9
, t neg8
, t neg7
, t neg6
, t neg5
, t neg4
, t neg3
, t neg2
, t neg1
, t zero
, t pos1
, t pos2
, t pos3
, t pos4
, t pos5
, t pos6
, t pos7
, t pos8
, t pos9
, t pos10
, t pos11
, t pos12
] where
t x = TestList [ unaryTest' (+ pos1) (P.+ 1) x
, unaryTest' (+ neg1) (P.- 1) x
, unaryTest' (\x -> x - neg1) (P.+ 1) x
, unaryTest' (\x -> x - pos1) (P.- 1) x
, unaryTest' pred P.pred x
, unaryTest' succ P.succ x
]
-- | Test negation.
testNegate = TestLabel "Negation tests" $ TestList
[ unaryTest negate P.negate neg12
, unaryTest negate P.negate neg11
, unaryTest negate P.negate neg10
, unaryTest negate P.negate neg9
, unaryTest negate P.negate neg8
, unaryTest negate P.negate neg7
, unaryTest negate P.negate neg6
, unaryTest negate P.negate neg5
, unaryTest negate P.negate neg4
, unaryTest negate P.negate neg3
, unaryTest negate P.negate neg2
, unaryTest negate P.negate neg1
, unaryTest negate P.negate zero
, unaryTest negate P.negate pos1
, unaryTest negate P.negate pos2
, unaryTest negate P.negate pos3
, unaryTest negate P.negate pos4
, unaryTest negate P.negate pos5
, unaryTest negate P.negate pos6
, unaryTest negate P.negate pos7
, unaryTest negate P.negate pos8
, unaryTest negate P.negate pos9
, unaryTest negate P.negate pos10
, unaryTest negate P.negate pos11
, unaryTest negate P.negate pos12
]
-- | Test absolute value.
testAbs = TestLabel "Absolute value tests" $ TestList
[ unaryTest abs P.abs neg12
, unaryTest abs P.abs neg11
, unaryTest abs P.abs neg10
, unaryTest abs P.abs neg9
, unaryTest abs P.abs neg8
, unaryTest abs P.abs neg7
, unaryTest abs P.abs neg6
, unaryTest abs P.abs neg5
, unaryTest abs P.abs neg4
, unaryTest abs P.abs neg3
, unaryTest abs P.abs neg2
, unaryTest abs P.abs neg1
, unaryTest abs P.abs zero
, unaryTest abs P.abs pos1
, unaryTest abs P.abs pos2
, unaryTest abs P.abs pos3
, unaryTest abs P.abs pos4
, unaryTest abs P.abs pos5
, unaryTest abs P.abs pos6
, unaryTest abs P.abs pos7
, unaryTest abs P.abs pos8
, unaryTest abs P.abs pos9
, unaryTest abs P.abs pos10
, unaryTest abs P.abs pos11
, unaryTest abs P.abs pos12
]
-- | Test signum.
testSignum = TestLabel "Signum tests" $ TestList
[ unaryTest signum P.signum neg12
, unaryTest signum P.signum neg11
, unaryTest signum P.signum neg10
, unaryTest signum P.signum neg9
, unaryTest signum P.signum neg8
, unaryTest signum P.signum neg7
, unaryTest signum P.signum neg6
, unaryTest signum P.signum neg5
, unaryTest signum P.signum neg4
, unaryTest signum P.signum neg3
, unaryTest signum P.signum neg2
, unaryTest signum P.signum neg1
, unaryTest signum P.signum zero
, unaryTest signum P.signum pos1
, unaryTest signum P.signum pos2
, unaryTest signum P.signum pos3
, unaryTest signum P.signum pos4
, unaryTest signum P.signum pos5
, unaryTest signum P.signum pos6
, unaryTest signum P.signum pos7
, unaryTest signum P.signum pos8
, unaryTest signum P.signum pos9
, unaryTest signum P.signum pos10
, unaryTest signum P.signum pos11
, unaryTest signum P.signum pos12
]
-- | Test absolute value.
testAbs = TestLabel "Absolute value tests" $ TestList
[ unaryTest abs P.abs neg2
, unaryTest abs P.abs neg1
, unaryTest abs P.abs zero
, unaryTest abs P.abs pos1
, unaryTest abs P.abs pos1
]
-- | Test signum.
testSignum = TestLabel "Signum tests" $ TestList
[ unaryTest signum P.signum neg2
, unaryTest signum P.signum neg1
, unaryTest signum P.signum zero
, unaryTest signum P.signum pos1
, unaryTest signum P.signum pos1
]
-- | Test addition.
testAddition = TestLabel "Addition tests" $ TestList
[ binaryTest (+) (P.+) pos2 pos5
, binaryTest (+) (P.+) pos12 pos2
, binaryTest (+) (P.+) pos11 pos2
, binaryTest (+) (P.+) pos10 pos2
, binaryTest (+) (P.+) pos2 pos12
, binaryTest (+) (P.+) pos2 pos11
, binaryTest (+) (P.+) pos2 pos10
, binaryTest (+) (P.+) neg2 pos5
, binaryTest (+) (P.+) pos2 neg5
, binaryTest (+) (P.+) neg2 neg5
, binaryTest (+) (P.+) neg2 neg12
, binaryTest (+) (P.+) neg2 neg11
, binaryTest (+) (P.+) neg2 neg10
, binaryTest (+) (P.+) neg12 neg2
, binaryTest (+) (P.+) neg11 neg2
, binaryTest (+) (P.+) neg10 neg2
, binaryTest (+) (P.+) zero zero
, binaryTest (+) (P.+) pos2 zero
, binaryTest (+) (P.+) neg2 zero
, binaryTest (+) (P.+) zero pos5
, binaryTest (+) (P.+) zero neg5
]
-- | Test subtraction.
testSubtraction = TestLabel "Subtraction tests" $ TestList
[ binaryTest (-) (P.-) pos2 pos5
, binaryTest (-) (P.-) pos12 pos2
, binaryTest (-) (P.-) pos11 pos2
, binaryTest (-) (P.-) pos10 pos2
, binaryTest (-) (P.-) pos2 pos12
, binaryTest (-) (P.-) pos2 pos11
, binaryTest (-) (P.-) pos2 pos10
, binaryTest (-) (P.-) neg2 pos5
, binaryTest (-) (P.-) pos2 neg5
, binaryTest (-) (P.-) neg2 neg5
, binaryTest (-) (P.-) neg2 neg12
, binaryTest (-) (P.-) neg2 neg11
, binaryTest (-) (P.-) neg2 neg10
, binaryTest (-) (P.-) neg12 neg2
, binaryTest (-) (P.-) neg11 neg2
, binaryTest (-) (P.-) neg10 neg2
, binaryTest (-) (P.-) zero zero
, binaryTest (-) (P.-) pos2 zero
, binaryTest (-) (P.-) neg2 zero
, binaryTest (-) (P.-) zero pos5
, binaryTest (-) (P.-) zero neg5
]
-- | Test multiplication.
testMultiplication = TestLabel "Multiplication tests" $ TestList
[ binaryTest (*) (P.*) pos2 pos5
, binaryTest (*) (P.*) pos12 pos2
, binaryTest (*) (P.*) pos11 pos2
, binaryTest (*) (P.*) pos10 pos2
, binaryTest (*) (P.*) pos2 pos12
, binaryTest (*) (P.*) pos2 pos11
, binaryTest (*) (P.*) pos2 pos10
, binaryTest (*) (P.*) neg2 pos5
, binaryTest (*) (P.*) pos2 neg5
, binaryTest (*) (P.*) neg2 neg5
, binaryTest (*) (P.*) neg2 neg12
, binaryTest (*) (P.*) neg2 neg11
, binaryTest (*) (P.*) neg2 neg10
, binaryTest (*) (P.*) neg12 neg2
, binaryTest (*) (P.*) neg11 neg2
, binaryTest (*) (P.*) neg10 neg2
, binaryTest (*) (P.*) zero zero
, binaryTest (*) (P.*) pos2 zero
, binaryTest (*) (P.*) neg2 zero
, binaryTest (*) (P.*) zero pos5
, binaryTest (*) (P.*) zero neg5
-- Probably some duplicates in the below.
, binaryTest (*) (P.*) pos10 pos2
, binaryTest (*) (P.*) pos9 pos3
, binaryTest (*) (P.*) pos8 pos4
, binaryTest (*) (P.*) pos8 pos2
, binaryTest (*) (P.*) pos6 pos3
, binaryTest (*) (P.*) pos6 pos2
, binaryTest (*) (P.*) pos4 pos2
, binaryTest (*) (P.*) pos9 neg3
, binaryTest (*) (P.*) pos8 neg4
, binaryTest (*) (P.*) pos8 neg2
, binaryTest (*) (P.*) pos6 neg3
, binaryTest (*) (P.*) pos6 neg2
, binaryTest (*) (P.*) pos4 neg2
, binaryTest (*) (P.*) zero pos5
, binaryTest (*) (P.*) zero neg3
, binaryTest (*) (P.*) neg4 pos2
, binaryTest (*) (P.*) neg6 pos2
, binaryTest (*) (P.*) neg6 pos3
, binaryTest (*) (P.*) neg8 pos2
, binaryTest (*) (P.*) neg8 pos4
, binaryTest (*) (P.*) neg9 pos3
, binaryTest (*) (P.*) neg4 neg2
, binaryTest (*) (P.*) neg6 neg2
, binaryTest (*) (P.*) neg6 neg3
, binaryTest (*) (P.*) neg8 neg2
, binaryTest (*) (P.*) neg8 neg4
, binaryTest (*) (P.*) neg9 neg3
, binaryTest (*) (P.*) neg12 pos4
]
-- | Test division.
testDivision = TestLabel "Division tests" $ TestList
[ binaryTest (/) (P./) pos12 pos4
, binaryTest (/) (P./) pos12 neg4
, binaryTest (/) (P./) pos10 pos5
, binaryTest (/) (P./) pos10 pos2
, binaryTest (/) (P./) pos9 pos3
, binaryTest (/) (P./) pos8 pos4
, binaryTest (/) (P./) pos8 pos2
, binaryTest (/) (P./) pos6 pos3
, binaryTest (/) (P./) pos6 pos2
, binaryTest (/) (P./) pos4 pos2
, binaryTest (/) (P./) pos9 neg3
, binaryTest (/) (P./) pos8 neg4
, binaryTest (/) (P./) pos8 neg2
, binaryTest (/) (P./) pos6 neg3
, binaryTest (/) (P./) pos6 neg2
, binaryTest (/) (P./) pos4 neg2
, binaryTest (/) (P./) zero pos5
, binaryTest (/) (P./) zero neg3
, binaryTest (/) (P./) neg4 pos2
, binaryTest (/) (P./) neg6 pos2
, binaryTest (/) (P./) neg6 pos3
, binaryTest (/) (P./) neg8 pos2
, binaryTest (/) (P./) neg8 pos4
, binaryTest (/) (P./) neg9 pos3
, binaryTest (/) (P./) neg4 neg2
, binaryTest (/) (P./) neg6 neg2
, binaryTest (/) (P./) neg6 neg3
, binaryTest (/) (P./) neg8 neg2
, binaryTest (/) (P./) neg8 neg4
, binaryTest (/) (P./) neg9 neg3
, binaryTest (/) (P./) neg12 pos4
, binaryTest (/) (P./) neg12 neg4
, binaryTest (/) (P./) neg10 neg5
, binaryTest (/) (P./) neg10 neg2
, binaryTest (/) (P./) pos5 pos5
, binaryTest (/) (P./) neg5 pos5
, binaryTest (/) (P./) pos5 neg5
, binaryTest (/) (P./) zero neg5
, binaryTest (/) (P./) zero pos5
, binaryTest (/) (P./) pos5 pos1
, binaryTest (/) (P./) pos5 neg1
, binaryTest (/) (P./) pos12 pos12
, binaryTest (/) (P./) neg12 pos12
, binaryTest (/) (P./) pos12 neg12
, binaryTest (/) (P./) zero neg12
, binaryTest (/) (P./) zero pos12
, binaryTest (/) (P./) pos12 pos1
, binaryTest (/) (P./) pos12 neg1
]
-- | Test exponentiation.
testExponentiation = TestLabel "Exponentiation tests" $ TestList
[ binaryTest (^) (P.^) pos2 pos3
, binaryTest (^) (P.^) zero pos5
, binaryTest (^) (P.^) neg2 pos3
, binaryTest (^) (P.^) pos3 pos3
, binaryTest (^) (P.^) pos3 pos2
, binaryTest (^) (P.^) pos3 pos1
, binaryTest (^) (P.^) pos2 pos4
, binaryTest (^) (P.^) pos2 pos3
, binaryTest (^) (P.^) pos2 pos2
, binaryTest (^) (P.^) pos2 pos1
, binaryTest (^) (P.^) pos1 pos12
, binaryTest (^) (P.^) pos1 pos9
, binaryTest (^) (P.^) pos1 zero
, binaryTest (^) (P.^) neg3 pos3
, binaryTest (^) (P.^) neg3 pos2
, binaryTest (^) (P.^) neg3 pos1
, binaryTest (^) (P.^) neg2 pos4
, binaryTest (^) (P.^) neg2 pos3
, binaryTest (^) (P.^) neg2 pos2
, binaryTest (^) (P.^) neg2 pos1
, binaryTest (^) (P.^) neg1 pos12
, binaryTest (^) (P.^) neg1 pos9
, binaryTest (^) (P.^) neg1 zero
]
-- | Collect the test cases.
tests = TestList
[ testAsIntegral
, testIncrDecr
, testNegate
, testAbs
, testSignum
, testAddition
, testSubtraction
, testMultiplication
, testDivision
, testExponentiation
]
main = runTestTT tests