test/Test.hs

   1 import Utils
   2
   3 import Test.QuickCheck
   4 import Test.QuickCheck.Monadic
   5 import Test.Framework (Test, testGroup, defaultMain)
   6 import Test.Framework.Providers.QuickCheck2 (testProperty)
   7
   8 import Control.Exception (catch)
   9 import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
  10 import Data.Monoid (Monoid(..))
  11 import Control.Monad
  12 import Data.String (fromString)
  13 import Data.Text.Encoding.Error
  14 import qualified Data.List as L
  15
  16 import qualified Data.Bits as Bits (shiftL, shiftR)
  17 import qualified Data.ByteString as B
  18 import qualified Data.ByteString.Lazy as BL
  19 import qualified Data.Text as T
  20 import qualified Data.Text.Lazy as TL
  21 import qualified Data.Text.Encoding as E
  22 import qualified Pipes.Text.Internal as PE
  23 import qualified Pipes.Text as TP
  24 import qualified Pipes.ByteString as BP
  25 import qualified Pipes as P
  26 import Debug.Trace
  27
  28 main :: IO ()
  29 main = defaultMain [tests]
  30 -- >>> :main  -a 10000
  31
  32 tests = testGroup "stream_decode" [
  33   -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
  34 --  testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ] -- ,
  35   testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe]
  36
  37 t_utf8_incr_valid  = do
  38         Positive n <- arbitrary
  39         forAll genUnicode $ recode n `eq` id
  40     where recode n = T.concat . feedChunksOf n PE.streamDecodeUtf8 . E.encodeUtf8
  41           feedChunksOf :: Int -> (B.ByteString -> PE.Decoding) -> B.ByteString
  42                        -> [T.Text]
  43           feedChunksOf n f bs
  44             | B.null bs  = []
  45             | otherwise  = let (a,b) = B.splitAt n bs
  46                                PE.Some t _ f' = f a
  47                            in case f a of
  48                               PE.Some t _ f' -> t : feedChunksOf n f' b
  49                               _             -> []
  50
  51 t_utf8_incr_mixed  = do
  52        Positive n <- arbitrary
  53        txt <- genUnicode
  54        let chunkSize = mod n 7 + 1
  55        forAll (vector 9) $
  56               (roundtrip . chunk chunkSize . appendBytes txt) `eq` (appendBytes txt)
  57     where
  58     roundtrip :: [B.ByteString] -> B.ByteString
  59     roundtrip bss = go PE.streamDecodeUtf8 B.empty bss where
  60        go dec acc [] = acc
  61        go dec acc [bs]  = case dec bs of
  62           PE.Some t l dec' -> acc <> E.encodeUtf8 t <> l
  63           PE.Other t bs'   -> acc <> E.encodeUtf8 t <> bs'
  64        go dec acc (bs:bss) = case dec bs of
  65          PE.Some t l dec' -> go dec' (acc <> E.encodeUtf8 t) bss
  66          PE.Other t bs'   -> acc <> E.encodeUtf8 t <> bs' <> B.concat bss
  67     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
  68     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
  69
  70 t_utf8_incr_pipe  = do
  71        Positive  m <- arbitrary
  72        Positive n  <- arbitrary
  73        txt         <- genUnicode
  74        let chunkSize = mod n 7 + 1
  75            bytesLength = mod 3 m
  76        forAll (vector bytesLength) $
  77               (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt)
  78               `eq`
  79               appendBytes txt
  80     where
  81     roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r
  82     roundtrip p = join (TP.decodeUtf8 p P.>-> TP.encodeUtf8)
  83     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
  84     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
  85
  86
  87
  88
  89