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
  27 main :: IO ()
  28 main = defaultMain [tests]
  29 -- >>> :main  -a 10000
  30 tests = testGroup "stream_decode" [
  31   -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
  32   testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ,
  33   testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe,
  34   testProperty "t_utf8_incr_decoding" t_utf8_incr_decoding,
  35   testProperty "t_utf8_dec_some" t_utf8_dec_some]
  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 10 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 t_utf8_incr_decoding  = do
  88        Positive  m <- arbitrary
  89        Positive n  <- arbitrary
  90        txt         <- genUnicode
  91        let chunkSize = mod n 7 + 1
  92            bytesLength = mod 10 m
  93        forAll (vector bytesLength) $
  94               (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt)
  95               `eq`
  96               appendBytes txt
  97     where
  98     roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r
  99     roundtrip p = join (TP.decode utf8_start p P.>-> TP.encodeUtf8)
 100     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
 101     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
 102     utf8_start = PE.Some T.empty B.empty (PE.codecDecode PE.utf8)
 103 t_utf8_dec_some = do
 104        Positive  m <- arbitrary
 105        txt         <- genUnicode
 106        let bytesLength = mod 10 m :: Int
 107        forAll (vector bytesLength) $
 108               (roundtrip . appendBytes txt)
 109               `eq`
 110               appendBytes txt
 111     where
 112     roundtrip bs = case PE.decodeSomeUtf8 bs of
 113                         (txt,bys) -> E.encodeUtf8 txt <> bys
 114     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
 115
 116
 117
 118