git.iko.soy/text
on master help sign in
Move more utility functions away from Properties
7634e86Jasper Van der Jeugt
tests/tests/src/Data/Text/Tests/Properties.hs+28−154
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
1{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
2 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
2 ScopedTypeVariables, TypeSynonymInstances, CPP #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
4+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
4module Data.Text.Tests.Properties
5module Data.Text.Tests.Properties
5 (
6 (
6 tests
7 tests
@@ -10,41 +11,38 @@ import Test.QuickCheck
10import Test.QuickCheck.Monadic
11import Test.QuickCheck.Monadic
11import Text.Show.Functions ()
12import Text.Show.Functions ()
12
13
13−import qualified Data.Bits as Bits (shiftL, shiftR)
14+import Control.Arrow ((***), second)
14−import Numeric (showHex)
15+import Control.Exception (catch)
15import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
16import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
16import Data.Monoid (Monoid(..))
17import Data.Monoid (Monoid(..))
17import Data.String (fromString)
18import Data.String (fromString)
18−import Debug.Trace (trace)
19+import Data.Text.Encoding.Error
19−import Control.Arrow ((***), second)
20+import Data.Text.Foreign
20−import Control.DeepSeq
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)
21import Data.Word (Word8, Word16, Word32)
25import 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
22import qualified Data.Text as T
33import 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
28import qualified Data.Text.Encoding as E
34import 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
34import qualified Data.Text.Fusion as S
35import qualified Data.Text.Fusion as S
35import qualified Data.Text.Fusion.Common as S
36import 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
37import qualified Data.Text.Lazy.Encoding as EL
40import qualified Data.Text.Lazy.Encoding as EL
38import qualified Data.Text.Lazy.Fusion as SL
41import qualified Data.Text.Lazy.Fusion as SL
39−import qualified Data.Text.UnsafeShift as U
42+import qualified Data.Text.Lazy.IO as TL
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)
47import qualified Data.Text.Lazy.Search as S (indices)
43import qualified Data.Text.Lazy.Search as S (indices)
44+import qualified Data.Text.UnsafeShift as U
45+import qualified System.IO as IO
48
46
49import Data.Text.Tests.QuickCheckUtils
47import Data.Text.Tests.QuickCheckUtils
50import Data.Text.Tests.TestUtils
48import Data.Text.Tests.TestUtils
@@ -79,20 +77,10 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
79t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
77t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
80tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
78tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
81
79
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−
93-- This is a poor attempt to ensure that the error handling paths on
80-- This is a poor attempt to ensure that the error handling paths on
94-- decode are exercised in some way. Proper testing would be rather
81-- decode are exercised in some way. Proper testing would be rather
95-- more involved.
82-- more involved.
83+t_utf8_err :: DecodeErr -> B.ByteString -> Property
96t_utf8_err (DE _ de) bs = monadicIO $ do
84t_utf8_err (DE _ de) bs = monadicIO $ do
97 l <- run $ let len = T.length (E.decodeUtf8With de bs)
85 l <- run $ let len = T.length (E.decodeUtf8With de bs)
98 in (len `seq` return (Right len)) `catch`
86 in (len `seq` return (Right len)) `catch`
@@ -101,62 +89,11 @@ t_utf8_err (DE _ de) bs = monadicIO $ do
101 Left err -> assert $ length (show err) >= 0
89 Left err -> assert $ length (show err) >= 0
102 Right n -> assert $ n >= 0
90 Right n -> assert $ n >= 0
103
91
92+t_utf8_err' :: B.ByteString -> Property
104t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
93t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
105 Left err -> length (show err) >= 0
94 Left err -> length (show err) >= 0
106 Right t -> T.length t >= 0
95 Right t -> T.length t >= 0
107
96
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−
160s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
97s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
161 where _types = s :: String
98 where _types = s :: String
162sf_Eq p s =
99sf_Eq p s =
@@ -711,75 +648,12 @@ tl_rational = tl_read_rational TL.rational 1e-16
711
648
712-- Input and output.
649-- Input and output.
713
650
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−
777t_put_get = write_read T.unlines T.filter put get
651t_put_get = write_read T.unlines T.filter put get
778− where put h = withRedirect h stdout . T.putStr
652+ where put h = withRedirect h IO.stdout . T.putStr
779− get h = withRedirect h stdin T.getContents
653+ get h = withRedirect h IO.stdin T.getContents
780tl_put_get = write_read TL.unlines TL.filter put get
654tl_put_get = write_read TL.unlines TL.filter put get
781− where put h = withRedirect h stdout . TL.putStr
655+ where put h = withRedirect h IO.stdout . TL.putStr
782− get h = withRedirect h stdin TL.getContents
656+ get h = withRedirect h IO.stdin TL.getContents
783t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
657t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
784tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
658tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
785
659
tests/tests/src/Data/Text/Tests/QuickCheckUtils.hs+174−4
@@ -1,4 +1,9 @@
1+-- | This module provides quickcheck utilities, e.g. arbitrary and show
2+-- instances, and comparison functions, so we can focus on the actual properties
3+-- in the 'Data.Text.Tests.Properties' module.
4+--
1−{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
2module Data.Text.Tests.QuickCheckUtils
7module Data.Text.Tests.QuickCheckUtils
3 (
8 (
4 genUnicode
9 genUnicode
@@ -11,18 +16,41 @@ module Data.Text.Tests.QuickCheckUtils
11 , small
16 , small
12
17
13 , integralRandomR
18 , integralRandomR
19+
20+ , DecodeErr (..)
21+
22+ , Stringy (..)
23+ , eq
24+ , eqP
25+
26+ , Encoding (..)
27+
28+ , write_read
14 ) where
29 ) where
15
30
16−import Control.Arrow (first)
31+import Control.Arrow (first, (***))
32+import Control.DeepSeq (NFData (..), deepseq)
33+import Control.Exception (bracket)
17import Data.Bits ((.&.))
34import Data.Bits ((.&.))
18import Data.Char (chr)
35import Data.Char (chr)
36+import Data.Word (Word8, Word16)
19import Data.String (IsString, fromString)
37import Data.String (IsString, fromString)
20import Data.Text.Foreign (I16)
38import Data.Text.Foreign (I16)
39+import Debug.Trace (trace)
40+import System.Random (Random (..), RandomGen)
41+import Test.QuickCheck hiding ((.&.))
42+import Test.QuickCheck.Monadic (assert, monadicIO, run)
21import qualified Data.ByteString as B
43import qualified Data.ByteString as B
22import qualified Data.Text as T
44import qualified Data.Text as T
45+import qualified Data.Text.Encoding.Error as T
46+import qualified Data.Text.Fusion as TF
47+import qualified Data.Text.Fusion.Common as TF
23import qualified Data.Text.Lazy as TL
48import qualified Data.Text.Lazy as TL
24−import System.Random (Random (..), RandomGen)
49+import qualified Data.Text.Lazy.Fusion as TLF
25−import Test.QuickCheck hiding ((.&.))
50+import qualified Data.Text.Lazy.Internal as TL
51+import qualified System.IO as IO
52+
53+import Data.Text.Tests.TestUtils
26
54
27instance Random I16 where
55instance Random I16 where
28 randomR = integralRandomR
56 randomR = integralRandomR
@@ -165,3 +193,145 @@ integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
165integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
193integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
166 fromIntegral b :: Integer) g of
194 fromIntegral b :: Integer) g of
167 (x,h) -> (fromIntegral x, h)
195 (x,h) -> (fromIntegral x, h)
196+
197+data DecodeErr = DE String T.OnDecodeError
198+
199+instance Show DecodeErr where
200+ show (DE d _) = "DE " ++ d
201+
202+instance Arbitrary DecodeErr where
203+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
204+ , return $ DE "ignore" T.ignore
205+ , return $ DE "strict" T.strictDecode
206+ , DE "replace" `fmap` arbitrary ]
207+
208+class Stringy s where
209+ packS :: String -> s
210+ unpackS :: s -> String
211+ splitAtS :: Int -> s -> (s,s)
212+ packSChunkSize :: Int -> String -> s
213+ packSChunkSize _ = packS
214+
215+instance Stringy String where
216+ packS = id
217+ unpackS = id
218+ splitAtS = splitAt
219+
220+instance Stringy (TF.Stream Char) where
221+ packS = TF.streamList
222+ unpackS = TF.unstreamList
223+ splitAtS n s = (TF.take n s, TF.drop n s)
224+
225+instance Stringy T.Text where
226+ packS = T.pack
227+ unpackS = T.unpack
228+ splitAtS = T.splitAt
229+
230+instance Stringy TL.Text where
231+ packSChunkSize k = TLF.unstreamChunks k . TF.streamList
232+ packS = TL.pack
233+ unpackS = TL.unpack
234+ splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .
235+ TL.splitAt . fromIntegral
236+
237+-- Do two functions give the same answer?
238+eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
239+eq a b s = a s =^= b s
240+
241+-- What about with the RHS packed?
242+eqP :: (Eq a, Show a, Stringy s) =>
243+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool
244+eqP f g s w = eql "orig" (f s) (g t) &&
245+ eql "mini" (f s) (g mini) &&
246+ eql "head" (f sa) (g ta) &&
247+ eql "tail" (f sb) (g tb)
248+ where t = packS s
249+ mini = packSChunkSize 10 s
250+ (sa,sb) = splitAt m s
251+ (ta,tb) = splitAtS m t
252+ l = length s
253+ m | l == 0 = n
254+ | otherwise = n `mod` l
255+ n = fromIntegral w
256+ eql d a b
257+ | a =^= b = True
258+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
259+
260+-- Work around lack of Show instance for TextEncoding.
261+data Encoding = E String IO.TextEncoding
262+
263+instance Show Encoding where show (E n _) = "utf" ++ n
264+
265+instance Arbitrary Encoding where
266+ arbitrary = oneof . map return $
267+ [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16
268+ , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32
269+ , E "32le" IO.utf32le, E "32be" IO.utf32be
270+ ]
271+
272+windowsNewlineMode :: IO.NewlineMode
273+windowsNewlineMode = IO.NewlineMode
274+ { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF
275+ }
276+
277+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards
278+#if __GLASGOW_HASKELL__ < 700
279+instance Show Newline where
280+ show CRLF = "CRLF"
281+ show LF = "LF"
282+
283+instance Show NewlineMode where
284+ show (NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++
285+ ", outputNL = " ++ show o ++ " }"
286+# endif
287+
288+instance Arbitrary IO.NewlineMode where
289+ arbitrary = oneof . map return $
290+ [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode
291+ , windowsNewlineMode
292+ ]
293+
294+instance Arbitrary IO.BufferMode where
295+ arbitrary = oneof [ return IO.NoBuffering,
296+ return IO.LineBuffering,
297+ return (IO.BlockBuffering Nothing),
298+ (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`
299+ (arbitrary :: Gen Word16) ]
300+
301+-- This test harness is complex! What property are we checking?
302+--
303+-- Reading after writing a multi-line file should give the same
304+-- results as were written.
305+--
306+-- What do we vary while checking this property?
307+-- * The lines themselves, scrubbed to contain neither CR nor LF. (By
308+-- working with a list of lines, we ensure that the data will
309+-- sometimes contain line endings.)
310+-- * Encoding.
311+-- * Newline translation mode.
312+-- * Buffering.
313+write_read :: (NFData a, Eq a)
314+ => ([b] -> a)
315+ -> ((Char -> Bool) -> a -> b)
316+ -> (IO.Handle -> a -> IO ())
317+ -> (IO.Handle -> IO a)
318+ -> Encoding
319+ -> IO.NewlineMode
320+ -> IO.BufferMode
321+ -> [a]
322+ -> Property
323+write_read unline filt writer reader (E _ enc) nl buf ts =
324+ monadicIO $ assert . (==t) =<< run act
325+ where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
326+ act = withTempFile $ \path h -> do
327+ -- hSetEncoding h enc
328+ IO.hSetNewlineMode h nl
329+ IO.hSetBuffering h buf
330+ () <- writer h t
331+ IO.hClose h
332+ bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do
333+ -- hSetEncoding h' enc
334+ IO.hSetNewlineMode h' nl
335+ IO.hSetBuffering h' buf
336+ r <- reader h'
337+ r `deepseq` return r
tests/tests/text-tests.cabal−2
@@ -27,8 +27,6 @@ executable text-tests
27 -Wall
27 -Wall
28 -threaded
28 -threaded
29 -O0
29 -O0
30− -fno-warn-orphans
31− -fno-warn-missing-signatures
32
30
33 -- Optional HPC support
31 -- Optional HPC support
34 if flag(hpc)
32 if flag(hpc)