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
|
{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
TypeSynonymInstances #-}
module QC.Buffer (tests) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Monoid (Monoid(mconcat))
#endif
import QC.Common ()
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.ByteString.Buffer as BB
import qualified Data.Attoparsec.Text.Buffer as BT
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.Text as T
import qualified Data.Text.Unsafe as T
data BP t b = BP [t] !t !b
deriving (Eq, Show)
type BPB = BP B.ByteString BB.Buffer
type BPT = BP T.Text BT.Buffer
instance Arbitrary BPB where
arbitrary = do
bss <- arbitrary
return $! toBP BB.buffer bss
shrink (BP bss _ _) = toBP BB.buffer <$> shrink bss
instance Arbitrary BPT where
arbitrary = do
bss <- arbitrary
return $! toBP BT.buffer bss
shrink (BP bss _ _) = toBP BT.buffer <$> shrink bss
toBP :: (Monoid a, Monoid b) => (a -> b) -> [a] -> BP a b
toBP buf bss = BP bss (mconcat bss) (mconcat (map buf bss))
b_unbuffer :: BPB -> Property
b_unbuffer (BP _ts t buf) = t === BB.unbuffer buf
t_unbuffer :: BPT -> Property
t_unbuffer (BP _ts t buf) = t === BT.unbuffer buf
-- This test triggers both branches in Data.Attoparsec.Text.Buffer.append
-- and checks that Data.Text.Array.copyI manipulations are correct.
t_unbuffer_three :: Property
t_unbuffer_three = t_unbuffer $ toBP BT.buffer [t, t, t]
where
-- Make it long enough to increase chances of a segmentation fault
t = T.replicate 1000 "\0"
b_length :: BPB -> Property
b_length (BP _ts t buf) = B.length t === BB.length buf
t_length :: BPT -> Property
t_length (BP _ts t buf) = BT.lengthCodeUnits t === BT.length buf
b_unsafeIndex :: BPB -> Gen Property
b_unsafeIndex (BP _ts t buf) = do
let l = B.length t
i <- choose (0,l-1)
return $ l === 0 .||. B.unsafeIndex t i === BB.unsafeIndex buf i
t_iter :: BPT -> Gen Property
t_iter (BP _ts t buf) = do
let l = BT.lengthCodeUnits t
i <- choose (0,l-1)
let it (T.Iter c q) = (c,q)
return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)
t_iter_ :: BPT -> Gen Property
t_iter_ (BP _ts t buf) = do
let l = BT.lengthCodeUnits t
i <- choose (0,l-1)
return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i
b_unsafeDrop :: BPB -> Gen Property
b_unsafeDrop (BP _ts t buf) = do
i <- choose (0, B.length t)
return $ B.unsafeDrop i t === BB.unsafeDrop i buf
t_dropCodeUnits :: BPT -> Gen Property
t_dropCodeUnits (BP _ts t buf) = do
i <- choose (0, BT.lengthCodeUnits t)
return $ dropCodeUnits i t === BT.dropCodeUnits i buf
where
#if MIN_VERSION_text(2,0,0)
dropCodeUnits = T.dropWord8
#else
dropCodeUnits = T.dropWord16
#endif
tests :: [TestTree]
tests = [
testProperty "b_unbuffer" b_unbuffer
, testProperty "t_unbuffer" t_unbuffer
, testProperty "t_unbuffer_three" t_unbuffer_three
, testProperty "b_length" b_length
, testProperty "t_length" t_length
, testProperty "b_unsafeIndex" b_unsafeIndex
, testProperty "t_iter" t_iter
, testProperty "t_iter_" t_iter_
, testProperty "b_unsafeDrop" b_unsafeDrop
, testProperty "t_dropCodeUnits" t_dropCodeUnits
]
|
