@@ -9,9 +9,9 @@ module Tests.Properties
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
13import Data.Bits ((.&.))
13import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
17import Data.String (IsString(fromString))
17import Data.String (IsString(fromString))
@@ -23,7 +23,6 @@ import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
24import Data.Text.Read as T
25import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Data.Maybe (mapMaybe)
27import Numeric (showEFloat, showFFloat, showGFloat, showHex)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28import Prelude hiding (replicate)
27import Prelude hiding (replicate)
29import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
@@ -31,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.QuickCheck hiding ((.&.))
30import Test.QuickCheck hiding ((.&.))
32import Test.QuickCheck.Monadic
31import Test.QuickCheck.Monadic
33import Test.QuickCheck.Property (Property(..))
32import Test.QuickCheck.Property (Property(..))
34−import Test.QuickCheck.Unicode (char)
35import Tests.QuickCheckUtils
33import Tests.QuickCheckUtils
36import Tests.Utils
34import Tests.Utils
37import Text.Show.Functions ()
35import Text.Show.Functions ()
@@ -39,7 +37,6 @@ import qualified Control.Exception as Exception
39import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
40import qualified Data.ByteString as B
38import qualified Data.ByteString as B
41import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
42−import qualified Data.Char as C
43import qualified Data.List as L
40import qualified Data.List as L
44import qualified Data.Text as T
41import qualified Data.Text as T
45import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
@@ -63,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
65tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
66−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
67−t_singleton c = [c] === (T.unpack . T.singleton) c
64+t_singleton c = [c] == (T.unpack . T.singleton) c
68−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
69−tl_unstreamChunks x = f 11 x === f 1000 x
66+tl_unstreamChunks x = f 11 x == f 1000 x
70 where f n = SL.unstreamChunks n . S.streamList
67 where f n = SL.unstreamChunks n . S.streamList
71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -77,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
77encodeLazyL1 :: TL.Text -> BL.ByteString
74encodeLazyL1 :: TL.Text -> BL.ByteString
78encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
80−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
81 where a = T.map (\c -> chr (ord c `mod` 128)) t
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
82−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
79+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
83 where a = TL.map (\c -> chr (ord c `mod` 128)) t
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
84−t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
85 where a = T.map (\c -> chr (ord c `mod` 256)) t
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
86−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
87 where a = TL.map (\c -> chr (ord c `mod` 256)) t
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -114,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
114 let b = E.encodeUtf8 t
111 let b = E.encodeUtf8 t
115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116 leftover = (++ [B.empty]) . init . tail . B.inits
113 leftover = (++ [B.empty]) . init . tail . B.inits
117− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
119data Badness = Solo | Leading | Trailing
116data Badness = Solo | Leading | Trailing
120 deriving (Eq, Show)
117 deriving (Eq, Show)
@@ -180,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
180 k <- choose (0,n)
177 k <- choose (0,n)
181 vectorOf k gen
178 vectorOf k gen
183−-- See http://unicode.org/faq/utf_bom.html#gen8
184−-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ...
185−-- When faced with this illegal byte sequence ... a UTF-8 conformant process
186−-- must treat the first byte 110xxxxx2 as an illegal termination error
187−-- (e.g. filter it out or replace by 0xFFFD) ...
188−-- ... and continue processing at the second byte 0xxxxxxx2
189−t_decode_with_error2 =
190− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa"
191−t_decode_with_error3 =
192− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa"
193−t_decode_with_error4 =
194− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa"
196−t_decode_with_error2' =
197− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of
198− E.Some x _ _ -> x === "xa"
199−t_decode_with_error3' =
200− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of
201− E.Some x _ _ -> x === "xaa"
202−t_decode_with_error4' =
203− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of
204− E.Some x _ _ -> x === "xaaa"
206−t_infix_concat bs1 text bs2 rep =
208− E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211 where _types = s :: String
181 where _types = s :: String
212sf_Eq p s =
182sf_Eq p s =
@@ -231,8 +201,8 @@ t_mconcat = unsquare $
231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232tl_mconcat = unsquare $
202tl_mconcat = unsquare $
233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234−t_mempty = mempty === (unpackS (mempty :: T.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
235−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
237tl_IsString = fromString `eqP` (TL.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
@@ -259,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
259 (fmap (second unpackS) . S.uncons . S.filter p)
229 (fmap (second unpackS) . S.uncons . S.filter p)
260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
263−unsnoc xs@(_:_) = Just (init xs, last xs)
266−t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
267−tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
269s_head = head `eqP` S.head
232s_head = head `eqP` S.head
270sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
271t_head = head `eqP` T.head
234t_head = head `eqP` T.head
@@ -363,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
363 where p = T.length . T.filter isUpper
326 where p = T.length . T.filter isUpper
364tl_toUpper_upper t = p (TL.toUpper t) >= p t
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365 where p = TL.length . TL.filter isUpper
328 where p = TL.length . TL.filter isUpper
366−t_toTitle_title t = all (<= 1) (caps w)
367− where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
368− -- TIL: there exist uppercase-only letters
369− w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
370−t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
371− where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
372− -- Surprise! The Spanish/Portuguese ordinal indicators changed
373− -- from category Ll (letter, lowercase) to Lo (letter, other)
375− -- Oh, and there exist lowercase-only letters (see previous test)
376− stable c = if isLower c
377− then C.toUpper c /= c
378− else c /= '\170' && c /= '\186'
380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -564,20 +514,12 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
564s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
569− d <- suchThat char (/= c)
571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574 (unpackS . T.takeWhileEnd p)
520 (unpackS . T.takeWhileEnd p)
575−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576− T.takeWhileEnd (==d) (T.snoc t c)
577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578 (unpackS . TL.takeWhileEnd p)
522 (unpackS . TL.takeWhileEnd p)
579−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580− TL.takeWhileEnd (==d) (TL.snoc t c)
581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -778,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
778 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780 let s = T.intercalate t ts
722 let s = T.intercalate t ts
781− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
783-- Bit shifts.
725-- Bit shifts.
784shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -870,18 +812,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
870-- Reading.
812-- Reading.
872t_decimal (n::Int) s =
814t_decimal (n::Int) s =
873− T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
815+ T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
874 where t = T.dropWhile isDigit s
816 where t = T.dropWhile isDigit s
875tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
876− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
818+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
877 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
878t_hexadecimal m s ox =
820t_hexadecimal m s ox =
879− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
821+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
880 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
881 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
882 n = getPositive m :: Int
824 n = getPositive m :: Int
883tl_hexadecimal m s ox =
825tl_hexadecimal m s ox =
884− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
826+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
885 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
886 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
887 n = getPositive m :: Int
829 n = getPositive m :: Int
@@ -925,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
928−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
870+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
929 where n = small m
871 where n = small m
930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
932−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
934-- Regression tests.
876-- Regression tests.
935s_filter_eq s = S.filter p t == S.streamList (filter p s)
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -982,15 +924,6 @@ tests =
982 testGroup "errors" [
924 testGroup "errors" [
983 testProperty "t_utf8_err" t_utf8_err,
925 testProperty "t_utf8_err" t_utf8_err,
984 testProperty "t_utf8_err'" t_utf8_err'
926 testProperty "t_utf8_err'" t_utf8_err'
986− testGroup "error recovery" [
987− testProperty "t_decode_with_error2" t_decode_with_error2,
988− testProperty "t_decode_with_error3" t_decode_with_error3,
989− testProperty "t_decode_with_error4" t_decode_with_error4,
990− testProperty "t_decode_with_error2'" t_decode_with_error2',
991− testProperty "t_decode_with_error3'" t_decode_with_error3',
992− testProperty "t_decode_with_error4'" t_decode_with_error4',
993− testProperty "t_infix_concat" t_infix_concat
@@ -1034,8 +967,6 @@ tests =
1034 testProperty "sf_uncons" sf_uncons,
967 testProperty "sf_uncons" sf_uncons,
1035 testProperty "t_uncons" t_uncons,
968 testProperty "t_uncons" t_uncons,
1036 testProperty "tl_uncons" tl_uncons,
969 testProperty "tl_uncons" tl_uncons,
1037− testProperty "t_unsnoc" t_unsnoc,
1038− testProperty "tl_unsnoc" tl_unsnoc,
1039 testProperty "s_head" s_head,
970 testProperty "s_head" s_head,
1040 testProperty "sf_head" sf_head,
971 testProperty "sf_head" sf_head,
1041 testProperty "t_head" t_head,
972 testProperty "t_head" t_head,
@@ -1099,9 +1030,7 @@ tests =
1099 testProperty "tl_toLower_lower" tl_toLower_lower,
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1100 testProperty "t_toUpper_length" t_toUpper_length,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1101 testProperty "t_toUpper_upper" t_toUpper_upper,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1102− testProperty "tl_toUpper_upper" tl_toUpper_upper,
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
1103− testProperty "t_toTitle_title" t_toTitle_title,
1104− testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1107 testGroup "justification" [
1036 testGroup "justification" [
@@ -1218,9 +1147,7 @@ tests =
1218 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1219 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1224 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1225 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1226 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,