Skip to content

Commit ca73ae3

Browse files
LysxiaLysxia
authored
Modularize property tests (#323)
1 parent 160cec6 commit ca73ae3

File tree

13 files changed

+1682
-1487
lines changed

13 files changed

+1682
-1487
lines changed

‎tests/Tests/Properties.hs

Lines changed: 18 additions & 1446 deletions
Large diffs are not rendered by default.

‎tests/Tests/Properties/Basics.hs

Lines changed: 139 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,139 @@
1+
-- | Test basic text functions
2+
3+
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
4+
module Tests.Properties.Basics
5+
( testBasics
6+
) where
7+
8+
import Control.Arrow (first, second)
9+
import Test.Tasty (TestTree, testGroup)
10+
import Test.Tasty.QuickCheck (testProperty)
11+
import Tests.QuickCheckUtils
12+
import Text.Show.Functions ()
13+
import qualified Data.List as L
14+
import qualified Data.Text as T
15+
import qualified Data.Text.Internal.Fusion as S
16+
import qualified Data.Text.Internal.Fusion.Common as S
17+
import qualified Data.Text.Internal.Lazy.Fusion as SL
18+
import qualified Data.Text.Lazy as TL
19+
20+
s_cons x = (x:) `eqP` (unpackS . S.cons x)
21+
s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)
22+
sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)
23+
t_cons x = (x:) `eqP` (unpackS . T.cons x)
24+
tl_cons x = (x:) `eqP` (unpackS . TL.cons x)
25+
s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
26+
t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
27+
tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
28+
s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))
29+
s_append_s s = (s++) `eqP`
30+
(unpackS . S.unstream . S.append (S.streamList s))
31+
sf_append p s = (L.filter p s++) `eqP`
32+
(unpackS . S.append (S.filter p $ S.streamList s))
33+
t_append s = (s++) `eqP` (unpackS . T.append (packS s))
34+
35+
uncons (x:xs) = Just (x,xs)
36+
uncons _ = Nothing
37+
38+
s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)
39+
sf_uncons p = (uncons . L.filter p) `eqP`
40+
(fmap (second unpackS) . S.uncons . S.filter p)
41+
t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
42+
tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
43+
44+
unsnoc xs@(_:_) = Just (init xs, last xs)
45+
unsnoc [] = Nothing
46+
47+
t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
48+
tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
49+
50+
s_head = head `eqP` S.head
51+
sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
52+
t_head = head `eqP` T.head
53+
tl_head = head `eqP` TL.head
54+
s_last = last `eqP` S.last
55+
sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)
56+
t_last = last `eqP` T.last
57+
tl_last = last `eqP` TL.last
58+
s_tail = tail `eqP` (unpackS . S.tail)
59+
s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)
60+
sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
61+
t_tail = tail `eqP` (unpackS . T.tail)
62+
tl_tail = tail `eqP` (unpackS . TL.tail)
63+
s_init = init `eqP` (unpackS . S.init)
64+
s_init_s = init `eqP` (unpackS . S.unstream . S.init)
65+
sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)
66+
t_init = init `eqP` (unpackS . T.init)
67+
tl_init = init `eqP` (unpackS . TL.init)
68+
s_null = null `eqP` S.null
69+
sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)
70+
t_null = null `eqP` T.null
71+
tl_null = null `eqP` TL.null
72+
s_length = length `eqP` S.length
73+
sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)
74+
sl_length = (fromIntegral . length) `eqP` SL.length
75+
t_length = length `eqP` T.length
76+
tl_length = L.genericLength `eqP` TL.length
77+
t_compareLength t = (compare (T.length t)) `eq` T.compareLength t
78+
tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t
79+
80+
-- Regression tests.
81+
s_filter_eq s = S.filter p t == S.streamList (filter p s)
82+
where p = (/= S.last t)
83+
t = S.streamList s
84+
85+
testBasics :: TestTree
86+
testBasics =
87+
testGroup "basics" [
88+
testProperty "s_cons" s_cons,
89+
testProperty "s_cons_s" s_cons_s,
90+
testProperty "sf_cons" sf_cons,
91+
testProperty "t_cons" t_cons,
92+
testProperty "tl_cons" tl_cons,
93+
testProperty "s_snoc" s_snoc,
94+
testProperty "t_snoc" t_snoc,
95+
testProperty "tl_snoc" tl_snoc,
96+
testProperty "s_append" s_append,
97+
testProperty "s_append_s" s_append_s,
98+
testProperty "sf_append" sf_append,
99+
testProperty "t_append" t_append,
100+
testProperty "s_uncons" s_uncons,
101+
testProperty "sf_uncons" sf_uncons,
102+
testProperty "t_uncons" t_uncons,
103+
testProperty "tl_uncons" tl_uncons,
104+
testProperty "t_unsnoc" t_unsnoc,
105+
testProperty "tl_unsnoc" tl_unsnoc,
106+
testProperty "s_head" s_head,
107+
testProperty "sf_head" sf_head,
108+
testProperty "t_head" t_head,
109+
testProperty "tl_head" tl_head,
110+
testProperty "s_last" s_last,
111+
testProperty "sf_last" sf_last,
112+
testProperty "t_last" t_last,
113+
testProperty "tl_last" tl_last,
114+
testProperty "s_tail" s_tail,
115+
testProperty "s_tail_s" s_tail_s,
116+
testProperty "sf_tail" sf_tail,
117+
testProperty "t_tail" t_tail,
118+
testProperty "tl_tail" tl_tail,
119+
testProperty "s_init" s_init,
120+
testProperty "s_init_s" s_init_s,
121+
testProperty "sf_init" sf_init,
122+
testProperty "t_init" t_init,
123+
testProperty "tl_init" tl_init,
124+
testProperty "s_null" s_null,
125+
testProperty "sf_null" sf_null,
126+
testProperty "t_null" t_null,
127+
testProperty "tl_null" tl_null,
128+
testProperty "s_length" s_length,
129+
testProperty "sf_length" sf_length,
130+
testProperty "sl_length" sl_length,
131+
testProperty "t_length" t_length,
132+
testProperty "tl_length" tl_length,
133+
testProperty "t_compareLength" t_compareLength,
134+
testProperty "tl_compareLength" tl_compareLength,
135+
136+
testGroup "regressions" [
137+
testProperty "s_filter_eq" s_filter_eq
138+
]
139+
]

‎tests/Tests/Properties/Builder.hs

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
-- | Test @Builder@
2+
3+
{-# LANGUAGE CPP #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6+
module Tests.Properties.Builder
7+
( testBuilder
8+
) where
9+
10+
import Data.Monoid (Monoid(..))
11+
import Data.Int (Int8, Int16, Int32, Int64)
12+
import Data.Word (Word, Word8, Word16, Word32, Word64)
13+
import Numeric (showEFloat, showFFloat, showGFloat, showHex)
14+
import Test.QuickCheck
15+
import Test.Tasty (TestTree, testGroup)
16+
import Test.Tasty.QuickCheck (testProperty)
17+
import Tests.QuickCheckUtils
18+
import Text.Show.Functions ()
19+
import qualified Data.List as L
20+
import qualified Data.Text.Lazy as TL
21+
import qualified Data.Text.Lazy.Builder as TB
22+
import qualified Data.Text.Lazy.Builder.Int as TB
23+
import qualified Data.Text.Lazy.Builder.RealFloat as TB
24+
25+
-- Builder.
26+
27+
tb_singleton = id `eqP`
28+
(unpackS . TB.toLazyText . mconcat . map TB.singleton)
29+
tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .
30+
map (TB.fromText . packS))
31+
32+
tb_associative s1 s2 s3 =
33+
TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==
34+
TB.toLazyText ((b1 `mappend` b2) `mappend` b3)
35+
where b1 = TB.fromText (packS s1)
36+
b2 = TB.fromText (packS s2)
37+
b3 = TB.fromText (packS s3)
38+
39+
-- Numeric builder stuff.
40+
41+
tb_decimal :: (Integral a, Show a) => a -> Bool
42+
tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
43+
44+
tb_decimal_integer (a::Integer) = tb_decimal a
45+
tb_decimal_integer_big (Big a) = tb_decimal a
46+
tb_decimal_int (a::Int) = tb_decimal a
47+
tb_decimal_int8 (a::Int8) = tb_decimal a
48+
tb_decimal_int16 (a::Int16) = tb_decimal a
49+
tb_decimal_int32 (a::Int32) = tb_decimal a
50+
tb_decimal_int64 (a::Int64) = tb_decimal a
51+
tb_decimal_word (a::Word) = tb_decimal a
52+
tb_decimal_word8 (a::Word8) = tb_decimal a
53+
tb_decimal_word16 (a::Word16) = tb_decimal a
54+
tb_decimal_word32 (a::Word32) = tb_decimal a
55+
tb_decimal_word64 (a::Word64) = tb_decimal a
56+
57+
tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
58+
tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
59+
tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
60+
tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
61+
62+
tb_hex :: (Integral a, Show a) => a -> Bool
63+
tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
64+
65+
tb_hexadecimal_integer (a::Integer) = tb_hex a
66+
tb_hexadecimal_int (a::Int) = tb_hex a
67+
tb_hexadecimal_int8 (a::Int8) = tb_hex a
68+
tb_hexadecimal_int16 (a::Int16) = tb_hex a
69+
tb_hexadecimal_int32 (a::Int32) = tb_hex a
70+
tb_hexadecimal_int64 (a::Int64) = tb_hex a
71+
tb_hexadecimal_word (a::Word) = tb_hex a
72+
tb_hexadecimal_word8 (a::Word8) = tb_hex a
73+
tb_hexadecimal_word16 (a::Word16) = tb_hex a
74+
tb_hexadecimal_word32 (a::Word32) = tb_hex a
75+
tb_hexadecimal_word64 (a::Word64) = tb_hex a
76+
77+
tb_realfloat :: (RealFloat a, Show a) => a -> Bool
78+
tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
79+
80+
tb_realfloat_float (a::Float) = tb_realfloat a
81+
tb_realfloat_double (a::Double) = tb_realfloat a
82+
83+
showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS
84+
showFloat TB.Exponent (Just 0) = showEFloat (Just 1) -- see gh-231
85+
showFloat TB.Exponent p = showEFloat p
86+
showFloat TB.Fixed p = showFFloat p
87+
showFloat TB.Generic p = showGFloat p
88+
89+
tb_formatRealFloat :: (RealFloat a, Show a) =>
90+
a -> TB.FPFormat -> Precision a -> Property
91+
tb_formatRealFloat a fmt prec = cond ==>
92+
TB.formatRealFloat fmt p a ===
93+
TB.fromString (showFloat fmt p a "")
94+
where p = precision a prec
95+
cond = case (p,fmt) of
96+
#if MIN_VERSION_base(4,12,0)
97+
(Just 0, TB.Generic) -> False -- skipping due to gh-231
98+
#endif
99+
_ -> True
100+
101+
tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a
102+
tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
103+
104+
testBuilder :: TestTree
105+
testBuilder =
106+
testGroup "builder" [
107+
testProperty "tb_fromText" tb_fromText,
108+
testProperty "tb_singleton" tb_singleton,
109+
testProperty "tb_associative" tb_associative,
110+
testGroup "decimal" [
111+
testProperty "tb_decimal_int" tb_decimal_int,
112+
testProperty "tb_decimal_int8" tb_decimal_int8,
113+
testProperty "tb_decimal_int16" tb_decimal_int16,
114+
testProperty "tb_decimal_int32" tb_decimal_int32,
115+
testProperty "tb_decimal_int64" tb_decimal_int64,
116+
testProperty "tb_decimal_integer" tb_decimal_integer,
117+
testProperty "tb_decimal_integer_big" tb_decimal_integer_big,
118+
testProperty "tb_decimal_word" tb_decimal_word,
119+
testProperty "tb_decimal_word8" tb_decimal_word8,
120+
testProperty "tb_decimal_word16" tb_decimal_word16,
121+
testProperty "tb_decimal_word32" tb_decimal_word32,
122+
testProperty "tb_decimal_word64" tb_decimal_word64,
123+
testProperty "tb_decimal_big_int" tb_decimal_big_int,
124+
testProperty "tb_decimal_big_word" tb_decimal_big_word,
125+
testProperty "tb_decimal_big_int64" tb_decimal_big_int64,
126+
testProperty "tb_decimal_big_word64" tb_decimal_big_word64
127+
],
128+
testGroup "hexadecimal" [
129+
testProperty "tb_hexadecimal_int" tb_hexadecimal_int,
130+
testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,
131+
testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,
132+
testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,
133+
testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,
134+
testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,
135+
testProperty "tb_hexadecimal_word" tb_hexadecimal_word,
136+
testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,
137+
testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,
138+
testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,
139+
testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64
140+
],
141+
testGroup "realfloat" [
142+
testProperty "tb_realfloat_double" tb_realfloat_double,
143+
testProperty "tb_realfloat_float" tb_realfloat_float,
144+
testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,
145+
testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double
146+
]
147+
]

0 commit comments

Comments
 (0)