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