@@ -9,9 +9,9 @@ module Tests.Properties
99 ) where
1010
1111import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
12+import Control.Arrow ((***), first, second)
1313import 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)
1515import Data.Int (Int8, Int16, Int32, Int64)
1616import Data.Monoid (Monoid(..))
1717import Data.String (IsString(fromString))
@@ -23,6 +23,7 @@ import Data.Text.Internal.Search (indices)
2323import Data.Text.Lazy.Read as TL
2424import Data.Text.Read as T
2525import Data.Word (Word, Word8, Word16, Word32, Word64)
26+import Data.Maybe (mapMaybe)
2627import Numeric (showEFloat, showFFloat, showGFloat, showHex)
2728import Prelude hiding (replicate)
2829import Test.Framework (Test, testGroup)
@@ -30,6 +31,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
3031import Test.QuickCheck hiding ((.&.))
3132import Test.QuickCheck.Monadic
3233import Test.QuickCheck.Property (Property(..))
34+import Test.QuickCheck.Unicode (char)
3335import Tests.QuickCheckUtils
3436import Tests.Utils
3537import Text.Show.Functions ()
@@ -37,6 +39,7 @@ import qualified Control.Exception as Exception
3739import qualified Data.Bits as Bits (shiftL, shiftR)
3840import qualified Data.ByteString as B
3941import qualified Data.ByteString.Lazy as BL
42+import qualified Data.Char as C
4043import qualified Data.List as L
4144import qualified Data.Text as T
4245import qualified Data.Text.Encoding as E
@@ -60,10 +63,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
6063tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6164t_stream_unstream = (S.unstream . S.stream) `eq` id
6265tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
66+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
67+t_singleton c = [c] === (T.unpack . T.singleton) c
68+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
69+tl_unstreamChunks x = f 11 x === f 1000 x
6770 where f n = SL.unstreamChunks n . S.streamList
6871tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
6972tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +77,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
7477encodeLazyL1 :: TL.Text -> BL.ByteString
7578encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
7679
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
80+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
7881 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
8083 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
8285 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
8487 where a = TL.map (\c -> chr (ord c `mod` 256)) t
8588t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
8689t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +114,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111114 let b = E.encodeUtf8 t
112115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113116 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
115118
116119data Badness = Solo | Leading | Trailing
117120 deriving (Eq, Show)
@@ -177,6 +180,33 @@ genInvalidUTF8 = B.pack <$> oneof [
177180 k <- choose (0,n)
178181 vectorOf k gen
179182
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"
195+
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"
205+
206+t_infix_concat bs1 text bs2 rep =
207+ text `T.isInfixOf`
208+ E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
209+
180210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181211 where _types = s :: String
182212sf_Eq p s =
@@ -201,8 +231,8 @@ t_mconcat = unsquare $
201231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202232tl_mconcat = unsquare $
203233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
234+t_mempty = mempty === (unpackS (mempty :: T.Text))
235+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206236t_IsString = fromString `eqP` (T.unpack . fromString)
207237tl_IsString = fromString `eqP` (TL.unpack . fromString)
208238
@@ -229,6 +259,13 @@ sf_uncons p = (uncons . L.filter p) `eqP`
229259 (fmap (second unpackS) . S.uncons . S.filter p)
230260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231261tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
262+
263+unsnoc xs@(_:_) = Just (init xs, last xs)
264+unsnoc [] = Nothing
265+
266+t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
267+tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
268+
232269s_head = head `eqP` S.head
233270sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234271t_head = head `eqP` T.head
@@ -326,6 +363,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326363 where p = T.length . T.filter isUpper
327364tl_toUpper_upper t = p (TL.toUpper t) >= p t
328365 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)
374+ -- in Unicode 7.0
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'
329379
330380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -514,12 +564,20 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514564s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516566 (unpackS . S.takeWhile p . S.filter q)
567+noMatch = do
568+ c <- char
569+ d <- suchThat char (/= c)
570+ return (c,d)
517571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520574 (unpackS . T.takeWhileEnd p)
575+t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576+ T.takeWhileEnd (==d) (T.snoc t c)
521577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522578 (unpackS . TL.takeWhileEnd p)
579+tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580+ TL.takeWhileEnd (==d) (TL.snoc t c)
523581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524582s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -720,7 +778,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720778 conc = T.concat . TL.toChunks
721779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722780 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
781+ in Slow.indices t s === indices t s
724782
725783-- Bit shifts.
726784shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +870,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812870-- Reading.
813871
814872t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
873+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816874 where t = T.dropWhile isDigit s
817875tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
876+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819877 where t = TL.dropWhile isDigit s
820878t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
879+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822880 where t = T.dropWhile isHexDigit s
823881 p = if ox then "0x" else ""
824882 n = getPositive m :: Int
825883tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
884+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827885 where t = TL.dropWhile isHexDigit s
828886 p = if ox then "0x" else ""
829887 n = getPositive m :: Int
@@ -867,11 +925,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
867925
868926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869927t_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
928+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871929 where n = small m
872930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873931
874−t_copy t = T.copy t == t
932+t_copy t = T.copy t === t
875933
876934-- Regression tests.
877935s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -924,6 +982,15 @@ tests =
924982 testGroup "errors" [
925983 testProperty "t_utf8_err" t_utf8_err,
926984 testProperty "t_utf8_err'" t_utf8_err'
985+ ],
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
927994 ]
928995 ],
929996
@@ -967,6 +1034,8 @@ tests =
9671034 testProperty "sf_uncons" sf_uncons,
9681035 testProperty "t_uncons" t_uncons,
9691036 testProperty "tl_uncons" tl_uncons,
1037+ testProperty "t_unsnoc" t_unsnoc,
1038+ testProperty "tl_unsnoc" tl_unsnoc,
9701039 testProperty "s_head" s_head,
9711040 testProperty "sf_head" sf_head,
9721041 testProperty "t_head" t_head,
@@ -1030,7 +1099,9 @@ tests =
10301099 testProperty "tl_toLower_lower" tl_toLower_lower,
10311100 testProperty "t_toUpper_length" t_toUpper_length,
10321101 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1102+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1103+ testProperty "t_toTitle_title" t_toTitle_title,
1104+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
10341105 ],
10351106
10361107 testGroup "justification" [
@@ -1147,7 +1218,9 @@ tests =
11471218 testProperty "t_takeWhile" t_takeWhile,
11481219 testProperty "tl_takeWhile" tl_takeWhile,
11491220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221+ testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
11501222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223+ testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
11511224 testProperty "sf_dropWhile" sf_dropWhile,
11521225 testProperty "s_dropWhile" s_dropWhile,
11531226 testProperty "s_dropWhile_s" s_dropWhile_s,