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 Data.String (fromString)
  12 import Data.Text.Encoding.Error
  13 import qualified Data.List as L
  14
  15 import qualified Data.Bits as Bits (shiftL, shiftR)
  16 import qualified Data.ByteString as B
  17 import qualified Data.ByteString.Lazy as BL
  18 import qualified Data.Text as T
  19 import qualified Data.Text.Lazy as TL
  20 import qualified Data.Text.Encoding as E
  21 import qualified Pipes.Text.Internal as PE
  22
  23 main :: IO ()
  24 main = defaultMain [tests]
  25 -- >>> :main  -a 10000
  26
  27 tests = testGroup "stream_decode" [
  28
  29   testProperty "t_utf8_incr_valid" t_utf8_incr_valid,
  30   testProperty "t_utf8_incr_mixed" t_utf8_incr_mixed]
  31
  32 t_utf8_incr_valid  = do
  33         Positive n <- arbitrary
  34         forAll genUnicode $ recode n `eq` id
  35     where recode n = T.concat . feedChunksOf n PE.streamDecodeUtf8 . E.encodeUtf8
  36           feedChunksOf :: Int -> (B.ByteString -> PE.Decoding) -> B.ByteString
  37                        -> [T.Text]
  38           feedChunksOf n f bs
  39             | B.null bs  = []
  40             | otherwise  = let (a,b) = B.splitAt n bs
  41                                PE.Some t _ f' = f a
  42                            in case f a of
  43                               PE.Some t _ f' -> t : feedChunksOf n f' b
  44                               _             -> []
  45
  46 t_utf8_incr_mixed  = do
  47        Positive n <- arbitrary
  48        txt <- genUnicode
  49        forAll (vector 9) $ (roundtrip . chunk (mod n 7 + 1) . appendBytes txt) `eq` appendBytes txt
  50     where
  51     roundtrip :: [B.ByteString] -> B.ByteString
  52     roundtrip bss = go (PE.streamDecodeUtf8With Nothing) B.empty B.empty bss where
  53        go dec acc old [] = acc <> old
  54        go dec acc old (bs:bss) = case dec bs of
  55          PE.Some t new dec' -> if T.null t then go dec' (acc <> E.encodeUtf8 t) (old <> new) bss
  56                                            else go dec' (acc <> E.encodeUtf8 t) new bss
  57          PE.Other t bs' -> if T.null t then acc <> old <> bs <> B.concat bss
  58                                        else acc <> E.encodeUtf8 t <> bs' <> B.concat bss
  59     chunk n bs = let (a,b) = B.splitAt n bs in if B.null a then [] else a : chunk n b
  60     appendBytes txt bts = E.encodeUtf8 txt <> B.pack bts ; (<>) = B.append