foundation-0.0.13: tests/Checks.hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
module Main where
import Foundation
import Foundation.Array
import Foundation.Foreign
import Foundation.List.DList
import Foundation.Primitive
import Foundation.Check
import Foundation.Check.Main (defaultMain)
import Foundation.String
import Foundation.String.Read
import qualified Prelude
import Data.Ratio
import Test.Foundation.Random
import Test.Checks.Property.Collection
applyFstToSnd :: (String, String -> b) -> b
applyFstToSnd (a, fab) = fab a
matrixToGroup name l = Group name $ Prelude.concat $ fmap (fmap applyFstToSnd . snd) l
functorProxy :: Proxy f -> Proxy ty -> Proxy (f ty)
functorProxy _ _ = Proxy
primTypesMatrixArbitrary :: (forall ty . (PrimType ty, Typeable ty, Show ty, Ord ty) => Proxy ty -> Gen ty -> a)
-> [(String, [(String, a)])]
primTypesMatrixArbitrary f =
[ ("Words",
[ ("W8", f (Proxy :: Proxy Word8) arbitrary)
, ("W16", f (Proxy :: Proxy Word16) arbitrary)
, ("W32", f (Proxy :: Proxy Word32) arbitrary)
, ("W64", f (Proxy :: Proxy Word64) arbitrary)
, ("Word", f (Proxy :: Proxy Word) arbitrary)
])
, ("Ints",
[ ("I8", f (Proxy :: Proxy Int8) arbitrary)
, ("I16", f (Proxy :: Proxy Int16) arbitrary)
, ("I32", f (Proxy :: Proxy Int32) arbitrary)
, ("I64", f (Proxy :: Proxy Int64) arbitrary)
, ("Int", f (Proxy :: Proxy Int) arbitrary)
])
, ("Floating",
[ ("FP32", f (Proxy :: Proxy Float) arbitrary)
, ("FP64", f (Proxy :: Proxy Double) arbitrary)
])
, ("C-Types",
[ ("CChar", f (Proxy :: Proxy CChar) (CChar <$> arbitrary))
, ("CUChar", f (Proxy :: Proxy CUChar) (CUChar <$> arbitrary))
])
, ("Endian",
[ ("BE-W16", f (Proxy :: Proxy (BE Word16)) (toBE <$> arbitrary))
, ("BE-W32", f (Proxy :: Proxy (BE Word32)) (toBE <$> arbitrary))
, ("BE-W64", f (Proxy :: Proxy (BE Word64)) (toBE <$> arbitrary))
, ("LE-W16", f (Proxy :: Proxy (LE Word16)) (toLE <$> arbitrary))
, ("LE-W32", f (Proxy :: Proxy (LE Word32)) (toLE <$> arbitrary))
, ("LE-W64", f (Proxy :: Proxy (LE Word64)) (toLE <$> arbitrary))
])
]
testAdditive :: forall a . (Show a, Eq a, Typeable a, Additive a, Arbitrary a) => Proxy a -> Test
testAdditive _ = Group "Additive"
[ Property "eq" $ azero === (azero :: a)
, Property "a + azero == a" $ \(v :: a) -> v + azero === v
, Property "azero + a == a" $ \(v :: a) -> azero + v === v
, Property "a + b == b + a" $ \(v1 :: a) v2 -> v1 + v2 === v2 + v1
]
readFloatingExact' :: String -> Maybe (Bool, Natural, Word, Maybe Int)
readFloatingExact' str = readFloatingExact str (\s x y z -> Just (s,x,y,z))
doubleEqualApprox :: Double -> Double -> PropertyCheck
doubleEqualApprox d1 d2 = propertyCompare name (<) (abs d) lim
where
d = d2 - d1
name = show d1 <> " - " <> show d2 <> " (differential=" <> show (abs d) <> " )" <> " < " <> show lim
lim = min d1 d2 * (10^^(-15 :: Int))
main = defaultMain $ Group "foundation"
[ Group "Numerical"
[ Group "Int"
[ testAdditive (Proxy :: Proxy Int)
]
, Group "Word64"
[ testAdditive (Proxy :: Proxy Word64)
]
]
, Group "String"
[ Group "reading"
[ Group "integer"
[ Property "empty" $ readInteger "" === Nothing
, Property "just-sign" $ readInteger "-" === Nothing
, Property "extra-content" $ readInteger "-123a" === Nothing
, Property "any" $ \i -> readInteger (show i) === Just i
]
, Group "floating-exact"
[ Property "empty" $ readFloatingExact' "" === Nothing
, Property "just-sign" $ readFloatingExact' "-" === Nothing
, Property "extra-content" $ readFloatingExact' "-123a" === Nothing
, Property "no-dot-after" $ readFloatingExact' "-123." === Nothing
, Property "case0" $ readFloatingExact' "124890" === Just (False, 124890, 0, Nothing)
, Property "case1" $ readFloatingExact' "-123.1" === Just (True, 1231, 1, Nothing)
, Property "case2" $ readFloatingExact' "10001.001" === Just (False, 10001001, 3, Nothing)
{-
, Property "any" $ \s i (v :: Word8) n ->
let (integral,floating) = i `divMod` (10^v)
let vw = integralUpsize v :: Word
sfloat = show n
digits = integralCast (length sfloat) + vw
in readFloatingExact' ((if s then "-" else "") <> show i <> "." <> replicate vw '0' <> sfloat) === Just (s, i, Just (digits, n), Nothing)
-}
]
, Group "Double"
[ Property "case1" $ readDouble "96152.5" === Just 96152.5
, Property "case2" $ maybe (propertyFail "Nothing") (doubleEqualApprox 1.2300000000000002e102) $ readDouble "1.2300000000000002e102"
, Property "case3" $ maybe (propertyFail "Nothing") (doubleEqualApprox 0.00001204) $ readDouble "0.00001204"
, Property "case4" $ maybe (propertyFail "Nothing") (doubleEqualApprox 2.5e12) $ readDouble "2.5e12"
, Property "case5" $ maybe (propertyFail "Nothing") (doubleEqualApprox 6.0e-4) $ readDouble "6.0e-4"
, Property "case6" $ maybe (propertyFail "Nothing") ((===) (-31.548)) $ readDouble "-31.548"
, Property "case7" $ readDouble "1e100000000" === Just (1/0)
, Property "Prelude.read" $ \(d :: Double) -> case readDouble (show d) of
Nothing -> propertyFail "Nothing"
Just d' -> d' `doubleEqualApprox` (Prelude.read $ toList $ show d)
]
, Group "rational"
[ Property "case1" $ readRational "124.098" === Just (124098 % 1000)
]
]
, Group "conversion"
[ Property "lower" $ lower "This is MY test" === "this is my test"
, Property "upper" $ upper "This is MY test" === "THIS IS MY TEST"
]
]
, collectionProperties "DList a" (Proxy :: Proxy (DList Word8)) arbitrary
, Group "Array"
[ matrixToGroup "Block" $ primTypesMatrixArbitrary $ \prx arb s ->
collectionProperties ("Block " <> s) (functorProxy (Proxy :: Proxy Block) prx) arb
, matrixToGroup "Unboxed" $ primTypesMatrixArbitrary $ \prx arb s ->
collectionProperties ("Unboxed " <> s) (functorProxy (Proxy :: Proxy UArray) prx) arb
, Group "Boxed"
[ collectionProperties "Array(W8)" (Proxy :: Proxy (Array Word8)) arbitrary
, collectionProperties "Array(W16)" (Proxy :: Proxy (Array Word16)) arbitrary
, collectionProperties "Array(W32)" (Proxy :: Proxy (Array Word32)) arbitrary
, collectionProperties "Array(W64)" (Proxy :: Proxy (Array Word64)) arbitrary
, collectionProperties "Array(I8)" (Proxy :: Proxy (Array Int8)) arbitrary
, collectionProperties "Array(I16)" (Proxy :: Proxy (Array Int16)) arbitrary
, collectionProperties "Array(I32)" (Proxy :: Proxy (Array Int32)) arbitrary
, collectionProperties "Array(I64)" (Proxy :: Proxy (Array Int64)) arbitrary
, collectionProperties "Array(F32)" (Proxy :: Proxy (Array Float)) arbitrary
, collectionProperties "Array(F64)" (Proxy :: Proxy (Array Double)) arbitrary
, collectionProperties "Array(Int)" (Proxy :: Proxy (Array Int)) arbitrary
, collectionProperties "Array(Int,Int)" (Proxy :: Proxy (Array (Int,Int))) arbitrary
, collectionProperties "Array(Integer)" (Proxy :: Proxy (Array Integer)) arbitrary
, collectionProperties "Array(CChar)" (Proxy :: Proxy (Array CChar)) (CChar <$> arbitrary)
, collectionProperties "Array(CUChar)" (Proxy :: Proxy (Array CUChar)) (CUChar <$> arbitrary)
, collectionProperties "Array(BE W16)" (Proxy :: Proxy (Array (BE Word16))) (toBE <$> arbitrary)
, collectionProperties "Array(BE W32)" (Proxy :: Proxy (Array (BE Word32))) (toBE <$> arbitrary)
, collectionProperties "Array(BE W64)" (Proxy :: Proxy (Array (BE Word64))) (toBE <$> arbitrary)
, collectionProperties "Array(LE W16)" (Proxy :: Proxy (Array (LE Word16))) (toLE <$> arbitrary)
, collectionProperties "Array(LE W32)" (Proxy :: Proxy (Array (LE Word32))) (toLE <$> arbitrary)
, collectionProperties "Array(LE W64)" (Proxy :: Proxy (Array (LE Word64))) (toLE <$> arbitrary)
]
]
, Group "ChunkedUArray"
[ matrixToGroup "Unboxed" $ primTypesMatrixArbitrary $ \prx arb s ->
collectionProperties ("Unboxed " <> s) (functorProxy (Proxy :: Proxy ChunkedUArray) prx) arb
]
, testRandom
]