1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
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.Foundation.Misc
import Test.Foundation.Storable
import Test.Foundation.Number
import Test.Foundation.Conduit
import Test.Foundation.String
import Test.Foundation.Network.IPv4
import Test.Foundation.Network.IPv6
import Test.Foundation.String.Base64
import Test.Checks.Property.Collection
import Test.Foundation.Format
import qualified Test.Foundation.Bits as Bits
import qualified Test.Basement as Basement
#if MIN_VERSION_base(4,9,0)
import Test.Foundation.Primitive.BlockN
#endif
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)
, ("W128", f (Proxy :: Proxy Word128) arbitrary)
, ("W256", f (Proxy :: Proxy Word256) 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 "Number" testNumberRefs
]
, Basement.tests
, Bits.tests
, 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
, collectionProperties "Bitmap" (Proxy :: Proxy Bitmap) 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
]
, testStringRefs
, testForeignStorableRefs
, testNetworkIPv4
, testNetworkIPv6
, testBase64Refs
, testHexadecimal
, testUUID
, testRandom
, testConduit
#if MIN_VERSION_base(4,9,0)
, testBlockN
#endif
, testFormat
]
|
