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
  31 tests = testGroup "stream_decode" [
  32   -- testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
  33   testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed ,
  34   testProperty "t_utf8_incr_pipe" t_utf8_incr_pipe]
  35
  36 t_utf8_incr_valid  = do
  37         Positive n <- arbitrary
  38         forAll genUnicode $ recode n `eq` id
  39     where recode n = T.concat . feedChunksOf n PE.streamDecodeUtf8 . E.encodeUtf8
  40           feedChunksOf :: Int -> (B.ByteString -> PE.Decoding) -> B.ByteString
  41                        -> [T.Text]
  42           feedChunksOf n f bs
  43             | B.null bs  = []
  44             | otherwise  = let (a,b) = B.splitAt n bs
  45                                PE.Some t _ f' = f a
  46                            in case f a of
  47                               PE.Some t _ f' -> t : feedChunksOf n f' b
  48                               _             -> []
  49
  50 t_utf8_incr_mixed  = do
  51        Positive n <- arbitrary
  52        txt <- genUnicode
  53        let chunkSize = mod n 7 + 1
  54        forAll (vector 9) $
  55               (roundtrip . chunk chunkSize . appendBytes txt) `eq` (appendBytes txt)
  56     where
  57     roundtrip :: [B.ByteString] -> B.ByteString
  58     roundtrip bss = go PE.streamDecodeUtf8 B.empty bss where
  59        go dec acc [] = acc
  60        go dec acc [bs]  = case dec bs of
  61           PE.Some t l dec' -> acc <> E.encodeUtf8 t <> l
  62           PE.Other t bs'   -> acc <> E.encodeUtf8 t <> bs'
  63        go dec acc (bs:bss) = case dec bs of
  64          PE.Some t l dec' -> go dec' (acc <> E.encodeUtf8 t) bss
  65          PE.Other t bs'   -> acc <> E.encodeUtf8 t <> bs' <> B.concat bss
  66     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
  67     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
  68
  69 t_utf8_incr_pipe  = do
  70        Positive  m <- arbitrary
  71        Positive n  <- arbitrary
  72        txt         <- genUnicode
  73        let chunkSize = mod n 7 + 1
  74            bytesLength = mod 10 m
  75        forAll (vector bytesLength) $
  76               (BL.toStrict . BP.toLazy . roundtrip . P.each . chunk chunkSize . appendBytes txt)
  77               `eq`
  78               appendBytes txt
  79     where
  80     roundtrip :: Monad m => P.Producer B.ByteString m r -> P.Producer B.ByteString m r
  81     roundtrip p = join (TP.decodeUtf8 p P.>-> TP.encodeUtf8)
  82     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
  83     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append
  84
  85
  86
  87
  88