@@ -1,6 +1,7 @@
11{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
22 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
33{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
4+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
45module Data.Text.Tests.Properties
56 (
67 tests
@@ -10,41 +11,38 @@ import Test.QuickCheck
1011import Test.QuickCheck.Monadic
1112import Text.Show.Functions ()
1213
13−import qualified Data.Bits as Bits (shiftL, shiftR)
14−import Numeric (showHex)
14+import Control.Arrow ((***), second)
15+import Control.Exception (catch)
1516import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
1617import Data.Monoid (Monoid(..))
1718import Data.String (fromString)
18−import Debug.Trace (trace)
19−import Control.Arrow ((***), second)
20−import Control.DeepSeq
19+import Data.Text.Encoding.Error
20+import Data.Text.Foreign
21+import Data.Text.Fusion.Size
22+import Data.Text.Lazy.Read as TL
23+import Data.Text.Read as T
24+import Data.Text.Search (indices)
2125import Data.Word (Word8, Word16, Word32)
26+import Numeric (showHex)
27+import Prelude hiding (catch, replicate)
28+import Test.Framework (Test, testGroup)
29+import Test.Framework.Providers.QuickCheck2 (testProperty)
30+import qualified Data.Bits as Bits (shiftL, shiftR)
31+import qualified Data.ByteString as B
32+import qualified Data.List as L
2233import qualified Data.Text as T
23−import qualified Data.Text.IO as T
24−import qualified Data.Text.Lazy as TL
25−import qualified Data.Text.Lazy.IO as TL
26−import qualified Data.Text.Lazy.Internal as TL
27−import qualified Data.Text.Lazy.Builder as TB
2834import qualified Data.Text.Encoding as E
29−import Data.Text.Read as T
30−import Data.Text.Lazy.Read as TL
31−import Data.Text.Encoding.Error
32−import Control.Exception (SomeException, bracket, catch, evaluate, try)
33−import Data.Text.Foreign
3435import qualified Data.Text.Fusion as S
3536import qualified Data.Text.Fusion.Common as S
36−import Data.Text.Fusion.Size
37+import qualified Data.Text.IO as T
38+import qualified Data.Text.Lazy as TL
39+import qualified Data.Text.Lazy.Builder as TB
3740import qualified Data.Text.Lazy.Encoding as EL
3841import qualified Data.Text.Lazy.Fusion as SL
39−import qualified Data.Text.UnsafeShift as U
40−import qualified Data.List as L
41−import Prelude hiding (catch, replicate)
42−import System.IO
43−import System.IO.Unsafe (unsafePerformIO)
44−import Test.Framework (Test, defaultMain, testGroup)
45−import Test.Framework.Providers.QuickCheck2 (testProperty)
46−import Data.Text.Search (indices)
42+import qualified Data.Text.Lazy.IO as TL
4743import qualified Data.Text.Lazy.Search as S (indices)
44+import qualified Data.Text.UnsafeShift as U
45+import qualified System.IO as IO
4846
4947import Data.Text.Tests.QuickCheckUtils
5048import Data.Text.Tests.TestUtils
@@ -79,20 +77,10 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
7977t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
8078tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
8179
82−data DecodeErr = DE String OnDecodeError
83−
84−instance Show DecodeErr where
85− show (DE d _) = "DE " ++ d
86−
87−instance Arbitrary DecodeErr where
88− arbitrary = oneof [ return $ DE "lenient" lenientDecode
89− , return $ DE "ignore" ignore
90− , return $ DE "strict" strictDecode
91− , DE "replace" `fmap` arbitrary ]
92−
9380-- This is a poor attempt to ensure that the error handling paths on
9481-- decode are exercised in some way. Proper testing would be rather
9582-- more involved.
83+t_utf8_err :: DecodeErr -> B.ByteString -> Property
9684t_utf8_err (DE _ de) bs = monadicIO $ do
9785 l <- run $ let len = T.length (E.decodeUtf8With de bs)
9886 in (len `seq` return (Right len)) `catch`
@@ -101,62 +89,11 @@ t_utf8_err (DE _ de) bs = monadicIO $ do
10189 Left err -> assert $ length (show err) >= 0
10290 Right n -> assert $ n >= 0
10391
92+t_utf8_err' :: B.ByteString -> Property
10493t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
10594 Left err -> length (show err) >= 0
10695 Right t -> T.length t >= 0
10796
108−class Stringy s where
109− packS :: String -> s
110− unpackS :: s -> String
111− splitAtS :: Int -> s -> (s,s)
112− packSChunkSize :: Int -> String -> s
113− packSChunkSize _ = packS
114−
115−instance Stringy String where
116− packS = id
117− unpackS = id
118− splitAtS = splitAt
119−
120−instance Stringy (S.Stream Char) where
121− packS = S.streamList
122− unpackS = S.unstreamList
123− splitAtS n s = (S.take n s, S.drop n s)
124−
125−instance Stringy T.Text where
126− packS = T.pack
127− unpackS = T.unpack
128− splitAtS = T.splitAt
129−
130−instance Stringy TL.Text where
131− packSChunkSize k = SL.unstreamChunks k . S.streamList
132− packS = TL.pack
133− unpackS = TL.unpack
134− splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
135− TL.splitAt . fromIntegral
136−
137−-- Do two functions give the same answer?
138−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
139−eq a b s = a s =^= b s
140−
141−-- What about with the RHS packed?
142−eqP :: (Eq a, Show a, Stringy s) =>
143− (String -> a) -> (s -> a) -> String -> Word8 -> Bool
144−eqP f g s w = eql "orig" (f s) (g t) &&
145− eql "mini" (f s) (g mini) &&
146− eql "head" (f sa) (g ta) &&
147− eql "tail" (f sb) (g tb)
148− where t = packS s
149− mini = packSChunkSize 10 s
150− (sa,sb) = splitAt m s
151− (ta,tb) = splitAtS m t
152− l = length s
153− m | l == 0 = n
154− | otherwise = n `mod` l
155− n = fromIntegral w
156− eql d a b
157− | a =^= b = True
158− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
159−
16097s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
16198 where _types = s :: String
16299sf_Eq p s =
@@ -711,75 +648,12 @@ tl_rational = tl_read_rational TL.rational 1e-16
711648
712649-- Input and output.
713650
714−-- Work around lack of Show instance for TextEncoding.
715−data Encoding = E String TextEncoding
716−
717−instance Show Encoding where show (E n _) = "utf" ++ n
718−
719−instance Arbitrary Encoding where
720− arbitrary = oneof . map return $
721− [ E "8" utf8, E "8_bom" utf8_bom, E "16" utf16, E "16le" utf16le,
722− E "16be" utf16be, E "32" utf32, E "32le" utf32le, E "32be" utf32be ]
723−
724−windowsNewlineMode = NewlineMode { inputNL = CRLF, outputNL = CRLF }
725−
726−-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
727−#if __GLASGOW_HASKELL__ < 700
728−instance Show Newline where
729− show CRLF = "CRLF"
730− show LF = "LF"
731−
732−instance Show NewlineMode where
733− show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
734− ", outputNL = " ++ show o ++ " }"
735−# endif
736−
737−instance Arbitrary NewlineMode where
738− arbitrary = oneof . map return $
739− [ noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
740− windowsNewlineMode ]
741−
742−instance Arbitrary BufferMode where
743− arbitrary = oneof [ return NoBuffering,
744− return LineBuffering,
745− return (BlockBuffering Nothing),
746− (BlockBuffering . Just . (+1) . fromIntegral) `fmap`
747− (arbitrary :: Gen Word16) ]
748−
749−-- This test harness is complex! What property are we checking?
750−--
751−-- Reading after writing a multi-line file should give the same
752−-- results as were written.
753−--
754−-- What do we vary while checking this property?
755−-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
756−-- working with a list of lines, we ensure that the data will
757−-- sometimes contain line endings.)
758−-- * Encoding.
759−-- * Newline translation mode.
760−-- * Buffering.
761−write_read unline filt writer reader (E _ enc) nl buf ts =
762− monadicIO $ assert . (==t) =<< run act
763− where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
764− act = withTempFile $ \path h -> do
765− -- hSetEncoding h enc
766− hSetNewlineMode h nl
767− hSetBuffering h buf
768− () <- writer h t
769− hClose h
770− bracket (openFile path ReadMode) hClose $ \h' -> do
771− -- hSetEncoding h' enc
772− hSetNewlineMode h' nl
773− hSetBuffering h' buf
774− r <- reader h'
775− r `deepseq` return r
776−
777651t_put_get = write_read T.unlines T.filter put get
778− where put h = withRedirect h stdout . T.putStr
779− get h = withRedirect h stdin T.getContents
652+ where put h = withRedirect h IO.stdout . T.putStr
653+ get h = withRedirect h IO.stdin T.getContents
780654tl_put_get = write_read TL.unlines TL.filter put get
781− where put h = withRedirect h stdout . TL.putStr
782− get h = withRedirect h stdin TL.getContents
655+ where put h = withRedirect h IO.stdout . TL.putStr
656+ get h = withRedirect h IO.stdin TL.getContents
783657t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
784658tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
785659