Commits

Bryan O'Sullivan  committed a08f64a

Test the Buffer types

  • Participants
  • Parent commits 3f80dce

Comments (0)

Files changed (3)

File attoparsec.cabal

 
 test-suite tests
   type:           exitcode-stdio-1.0
-  hs-source-dirs: tests
+  hs-source-dirs: tests .
   main-is:        QC.hs
-  other-modules:  QC.ByteString
+  other-modules:  QC.Buffer
+                  QC.ByteString
                   QC.Combinator
                   QC.Common
                   QC.Text
     ghc-options: -Werror
 
   build-depends:
-    attoparsec,
+    array,
     base >= 4 && < 5,
     bytestring,
+    deepseq >= 1.1,
     QuickCheck >= 2.7,
+    scientific,
     test-framework >= 0.8.0.2,
     test-framework-quickcheck2 >= 0.3.0.3,
     text
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 module Main (main) where
 
+import qualified QC.Buffer as Buffer
 import qualified QC.ByteString as ByteString
 import qualified QC.Combinator as Combinator
 import qualified QC.Text as Text
 
 tests = [
     testGroup "bs" ByteString.tests
+  , testGroup "buf" Buffer.tests
   , testGroup "combinator" Combinator.tests
   , testGroup "text" Text.tests
   ]

File tests/QC/Buffer.hs

+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
+    TypeSynonymInstances #-}
+
+module QC.Buffer (tests) where
+
+import Data.Monoid (mconcat)
+import QC.Common ()
+import Test.Framework (Test)
+import Test.Framework.Providers.QuickCheck2 (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 $! BP bss (mconcat bss) (mconcat (map BB.buffer bss))
+
+instance Arbitrary BPT where
+  arbitrary = do
+    bss <- arbitrary
+    return $! BP bss (mconcat bss) (mconcat (map BT.buffer 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
+
+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) = T.lengthWord16 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 = T.lengthWord16 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 = T.lengthWord16 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_dropWord16 :: BPT -> Gen Property
+t_dropWord16 (BP _ts t buf) = do
+  i <- choose (0, T.lengthWord16 t)
+  return $ T.dropWord16 i t === BT.dropWord16 i buf
+
+tests :: [Test]
+tests = [
+    testProperty "b_unbuffer" b_unbuffer
+  , testProperty "t_unbuffer" t_unbuffer
+  , 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_dropWord16" t_dropWord16
+  ]