1{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
2    TypeSynonymInstances #-}
3
4module QC.Buffer (tests) where
5
6#if !MIN_VERSION_base(4,8,0)
7import Control.Applicative ((<$>))
8import Data.Monoid (Monoid(mconcat))
9#endif
10import QC.Common ()
11import Test.Tasty (TestTree)
12import Test.Tasty.QuickCheck (testProperty)
13import Test.QuickCheck
14import qualified Data.Attoparsec.ByteString.Buffer as BB
15import qualified Data.Attoparsec.Text.Buffer as BT
16import qualified Data.ByteString as B
17import qualified Data.ByteString.Unsafe as B
18import qualified Data.Text as T
19import qualified Data.Text.Unsafe as T
20
21data BP t b = BP [t] !t !b
22            deriving (Eq, Show)
23
24type BPB = BP B.ByteString BB.Buffer
25type BPT = BP T.Text BT.Buffer
26
27instance Arbitrary BPB where
28  arbitrary = do
29    bss <- arbitrary
30    return $! toBP BB.buffer bss
31
32  shrink (BP bss _ _) = toBP BB.buffer <$> shrink bss
33
34instance Arbitrary BPT where
35  arbitrary = do
36    bss <- arbitrary
37    return $! toBP BT.buffer bss
38
39  shrink (BP bss _ _) = toBP BT.buffer <$> shrink bss
40
41toBP :: (Monoid a, Monoid b) => (a -> b) -> [a] -> BP a b
42toBP buf bss = BP bss (mconcat bss) (mconcat (map buf bss))
43
44b_unbuffer :: BPB -> Property
45b_unbuffer (BP _ts t buf) = t === BB.unbuffer buf
46
47t_unbuffer :: BPT -> Property
48t_unbuffer (BP _ts t buf) = t === BT.unbuffer buf
49
50b_length :: BPB -> Property
51b_length (BP _ts t buf) = B.length t === BB.length buf
52
53t_length :: BPT -> Property
54t_length (BP _ts t buf) = T.lengthWord16 t === BT.length buf
55
56b_unsafeIndex :: BPB -> Gen Property
57b_unsafeIndex (BP _ts t buf) = do
58  let l = B.length t
59  i <- choose (0,l-1)
60  return $ l === 0 .||. B.unsafeIndex t i === BB.unsafeIndex buf i
61
62t_iter :: BPT -> Gen Property
63t_iter (BP _ts t buf) = do
64  let l = T.lengthWord16 t
65  i <- choose (0,l-1)
66  let it (T.Iter c q) = (c,q)
67  return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)
68
69t_iter_ :: BPT -> Gen Property
70t_iter_ (BP _ts t buf) = do
71  let l = T.lengthWord16 t
72  i <- choose (0,l-1)
73  return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i
74
75b_unsafeDrop :: BPB -> Gen Property
76b_unsafeDrop (BP _ts t buf) = do
77  i <- choose (0, B.length t)
78  return $ B.unsafeDrop i t === BB.unsafeDrop i buf
79
80t_dropWord16 :: BPT -> Gen Property
81t_dropWord16 (BP _ts t buf) = do
82  i <- choose (0, T.lengthWord16 t)
83  return $ T.dropWord16 i t === BT.dropWord16 i buf
84
85tests :: [TestTree]
86tests = [
87    testProperty "b_unbuffer" b_unbuffer
88  , testProperty "t_unbuffer" t_unbuffer
89  , testProperty "b_length" b_length
90  , testProperty "t_length" t_length
91  , testProperty "b_unsafeIndex" b_unsafeIndex
92  , testProperty "t_iter" t_iter
93  , testProperty "t_iter_" t_iter_
94  , testProperty "b_unsafeDrop" b_unsafeDrop
95  , testProperty "t_dropWord16" t_dropWord16
96  ]
97