@@ -9,9 +9,9 @@ module Tests.Properties
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
12+import Control.Arrow ((***), first, second)
13import Data.Bits ((.&.))
13import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, 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,6 +23,7 @@ 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)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27import Prelude hiding (replicate)
28import Prelude hiding (replicate)
28import Test.Framework (Test, testGroup)
29import Test.Framework (Test, testGroup)
@@ -30,6 +31,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
30import Test.QuickCheck hiding ((.&.))
31import Test.QuickCheck hiding ((.&.))
31import Test.QuickCheck.Monadic
32import Test.QuickCheck.Monadic
32import Test.QuickCheck.Property (Property(..))
33import Test.QuickCheck.Property (Property(..))
34+import Test.QuickCheck.Unicode (char)
33import Tests.QuickCheckUtils
35import Tests.QuickCheckUtils
34import Tests.Utils
36import Tests.Utils
35import Text.Show.Functions ()
37import Text.Show.Functions ()
@@ -37,6 +39,7 @@ import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
39import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
40import qualified Data.ByteString as B
39import qualified Data.ByteString.Lazy as BL
41import qualified Data.ByteString.Lazy as BL
42+import qualified Data.Char as C
40import qualified Data.List as L
43import qualified Data.List as L
41import qualified Data.Text as T
44import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
45import qualified Data.Text.Encoding as E
@@ -60,10 +63,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
65tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
66+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
67+t_singleton c = [c] === (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
68+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
69+tl_unstreamChunks x = f 11 x === f 1000 x
67 where f n = SL.unstreamChunks n . S.streamList
70 where f n = SL.unstreamChunks n . S.streamList
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +77,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
74encodeLazyL1 :: TL.Text -> BL.ByteString
77encodeLazyL1 :: TL.Text -> BL.ByteString
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
78encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
80+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
81 where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
82+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
83 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
84+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
85 where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
86+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
87 where a = TL.map (\c -> chr (ord c `mod` 256)) t
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +114,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111 let b = E.encodeUtf8 t
114 let b = E.encodeUtf8 t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113 leftover = (++ [B.empty]) . init . tail . B.inits
116 leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
117+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
116data Badness = Solo | Leading | Trailing
119data Badness = Solo | Leading | Trailing
117 deriving (Eq, Show)
120 deriving (Eq, Show)
@@ -177,6 +180,29 @@ genInvalidUTF8 = B.pack <$> oneof [
177 k <- choose (0,n)
180 k <- choose (0,n)
178 vectorOf k gen
181 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"
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
206s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181 where _types = s :: String
207 where _types = s :: String
182sf_Eq p s =
208sf_Eq p s =
@@ -201,8 +227,8 @@ t_mconcat = unsquare $
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
227 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202tl_mconcat = unsquare $
228tl_mconcat = unsquare $
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
229 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
230+t_mempty = mempty === (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
231+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206t_IsString = fromString `eqP` (T.unpack . fromString)
232t_IsString = fromString `eqP` (T.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
233tl_IsString = fromString `eqP` (TL.unpack . fromString)
@@ -229,6 +255,13 @@ sf_uncons p = (uncons . L.filter p) `eqP`
229 (fmap (second unpackS) . S.uncons . S.filter p)
255 (fmap (second unpackS) . S.uncons . S.filter p)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
256t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
257tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
259+unsnoc xs@(_:_) = Just (init xs, last xs)
262+t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
263+tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
232s_head = head `eqP` S.head
265s_head = head `eqP` S.head
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
266sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234t_head = head `eqP` T.head
267t_head = head `eqP` T.head
@@ -326,6 +359,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326 where p = T.length . T.filter isUpper
359 where p = T.length . T.filter isUpper
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
360tl_toUpper_upper t = p (TL.toUpper t) >= p t
328 where p = TL.length . TL.filter isUpper
361 where p = TL.length . TL.filter isUpper
362+t_toTitle_title t = all (<= 1) (caps w)
363+ where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
364+ -- TIL: there exist uppercase-only letters
365+ w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
366+t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
367+ where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
368+ -- Surprise! The Spanish/Portuguese ordinal indicators changed
369+ -- from category Ll (letter, lowercase) to Lo (letter, other)
371+ -- Oh, and there exist lowercase-only letters (see previous test)
372+ stable c = if isLower c
373+ then C.toUpper c /= c
374+ else c /= '\170' && c /= '\186'
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
376justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
377justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -514,12 +560,20 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
560s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
561sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516 (unpackS . S.takeWhile p . S.filter q)
562 (unpackS . S.takeWhile p . S.filter q)
565+ d <- suchThat char (/= c)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
567t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
568tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
569t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520 (unpackS . T.takeWhileEnd p)
570 (unpackS . T.takeWhileEnd p)
571+t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
572+ T.takeWhileEnd (==d) (T.snoc t c)
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
573tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522 (unpackS . TL.takeWhileEnd p)
574 (unpackS . TL.takeWhileEnd p)
575+tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
576+ TL.takeWhileEnd (==d) (TL.snoc t c)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
577s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
578s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
579sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -720,7 +774,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720 conc = T.concat . TL.toChunks
774 conc = T.concat . TL.toChunks
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
775t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722 let s = T.intercalate t ts
776 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
777+ in Slow.indices t s === indices t s
725-- Bit shifts.
779-- Bit shifts.
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
780shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +866,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812-- Reading.
866-- Reading.
814t_decimal (n::Int) s =
868t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
869+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816 where t = T.dropWhile isDigit s
870 where t = T.dropWhile isDigit s
817tl_decimal (n::Int) s =
871tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
872+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819 where t = TL.dropWhile isDigit s
873 where t = TL.dropWhile isDigit s
820t_hexadecimal m s ox =
874t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
875+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822 where t = T.dropWhile isHexDigit s
876 where t = T.dropWhile isHexDigit s
823 p = if ox then "0x" else ""
877 p = if ox then "0x" else ""
824 n = getPositive m :: Int
878 n = getPositive m :: Int
825tl_hexadecimal m s ox =
879tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
880+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827 where t = TL.dropWhile isHexDigit s
881 where t = TL.dropWhile isHexDigit s
828 p = if ox then "0x" else ""
882 p = if ox then "0x" else ""
829 n = getPositive m :: Int
883 n = getPositive m :: Int
@@ -867,11 +921,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
922t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
923t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
924+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871 where n = small m
925 where n = small m
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
926t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
874−t_copy t = T.copy t == t
928+t_copy t = T.copy t === t
876-- Regression tests.
930-- Regression tests.
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
931s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -924,6 +978,14 @@ tests =
924 testGroup "errors" [
978 testGroup "errors" [
925 testProperty "t_utf8_err" t_utf8_err,
979 testProperty "t_utf8_err" t_utf8_err,
926 testProperty "t_utf8_err'" t_utf8_err'
980 testProperty "t_utf8_err'" t_utf8_err'
982+ testGroup "error recovery" [
983+ testProperty "t_decode_with_error2" t_decode_with_error2,
984+ testProperty "t_decode_with_error3" t_decode_with_error3,
985+ testProperty "t_decode_with_error4" t_decode_with_error4,
986+ testProperty "t_decode_with_error2'" t_decode_with_error2',
987+ testProperty "t_decode_with_error3'" t_decode_with_error3',
988+ testProperty "t_decode_with_error4'" t_decode_with_error4'
@@ -967,6 +1029,8 @@ tests =
967 testProperty "sf_uncons" sf_uncons,
1029 testProperty "sf_uncons" sf_uncons,
968 testProperty "t_uncons" t_uncons,
1030 testProperty "t_uncons" t_uncons,
969 testProperty "tl_uncons" tl_uncons,
1031 testProperty "tl_uncons" tl_uncons,
1032+ testProperty "t_unsnoc" t_unsnoc,
1033+ testProperty "tl_unsnoc" tl_unsnoc,
970 testProperty "s_head" s_head,
1034 testProperty "s_head" s_head,
971 testProperty "sf_head" sf_head,
1035 testProperty "sf_head" sf_head,
972 testProperty "t_head" t_head,
1036 testProperty "t_head" t_head,
@@ -1030,7 +1094,9 @@ tests =
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1094 testProperty "tl_toLower_lower" tl_toLower_lower,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1095 testProperty "t_toUpper_length" t_toUpper_length,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1096 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1097+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1098+ testProperty "t_toTitle_title" t_toTitle_title,
1099+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1036 testGroup "justification" [
1102 testGroup "justification" [
@@ -1147,7 +1213,9 @@ tests =
1147 testProperty "t_takeWhile" t_takeWhile,
1213 testProperty "t_takeWhile" t_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1214 testProperty "tl_takeWhile" tl_takeWhile,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1215 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1216+ testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1217 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1218+ testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1219 testProperty "sf_dropWhile" sf_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1220 testProperty "s_dropWhile" s_dropWhile,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
1221 testProperty "s_dropWhile_s" s_dropWhile_s,