@@ -9,9 +9,9 @@ module Tests.Properties
99 ) where
1010
1111import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
1313import 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)
1515import Data.Int (Int8, Int16, Int32, Int64)
1616import Data.Monoid (Monoid(..))
1717import Data.String (IsString(fromString))
@@ -23,7 +23,6 @@ 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)
2726import Numeric (showEFloat, showFFloat, showGFloat, showHex)
2827import Prelude hiding (replicate)
2928import Test.Framework (Test, testGroup)
@@ -31,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
3130import Test.QuickCheck hiding ((.&.))
3231import Test.QuickCheck.Monadic
3332import Test.QuickCheck.Property (Property(..))
34−import Test.QuickCheck.Unicode (char)
3533import Tests.QuickCheckUtils
3634import Tests.Utils
3735import Text.Show.Functions ()
@@ -39,7 +37,6 @@ import qualified Control.Exception as Exception
3937import qualified Data.Bits as Bits (shiftL, shiftR)
4038import qualified Data.ByteString as B
4139import qualified Data.ByteString.Lazy as BL
42−import qualified Data.Char as C
4340import qualified Data.List as L
4441import qualified Data.Text as T
4542import qualified Data.Text.Encoding as E
@@ -63,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
6360tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6461t_stream_unstream = (S.unstream . S.stream) `eq` id
6562tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
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
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
7067 where f n = SL.unstreamChunks n . S.streamList
7168tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
7269tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -77,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
7774encodeLazyL1 :: TL.Text -> BL.ByteString
7875encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
7976
80−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
8178 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
8380 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
8582 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
8784 where a = TL.map (\c -> chr (ord c `mod` 256)) t
8885t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
8986t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -114,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
114111 let b = E.encodeUtf8 t
115112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116113 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
118115
119116data Badness = Solo | Leading | Trailing
120117 deriving (Eq, Show)
@@ -180,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
180177 k <- choose (0,n)
181178 vectorOf k gen
182179
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−
210180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211181 where _types = s :: String
212182sf_Eq p s =
@@ -231,8 +201,8 @@ t_mconcat = unsquare $
231201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232202tl_mconcat = unsquare $
233203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234−t_mempty = mempty === (unpackS (mempty :: T.Text))
235−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236206t_IsString = fromString `eqP` (T.unpack . fromString)
237207tl_IsString = fromString `eqP` (TL.unpack . fromString)
238208
@@ -259,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
259229 (fmap (second unpackS) . S.uncons . S.filter p)
260230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261231tl_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−
269232s_head = head `eqP` S.head
270233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
271234t_head = head `eqP` T.head
@@ -363,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
363326 where p = T.length . T.filter isUpper
364327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365328 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'
379329
380330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381331justifyRight 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)
564514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
565515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566516 (unpackS . S.takeWhile p . S.filter q)
567−noMatch = do
568− c <- char
569− d <- suchThat char (/= c)
570− return (c,d)
571517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574520 (unpackS . T.takeWhileEnd p)
575−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576− T.takeWhileEnd (==d) (T.snoc t c)
577521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578522 (unpackS . TL.takeWhileEnd p)
579−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580− TL.takeWhileEnd (==d) (TL.snoc t c)
581523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
583525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -778,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
778720 conc = T.concat . TL.toChunks
779721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780722 let s = T.intercalate t ts
781− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
782724
783725-- Bit shifts.
784726shiftL 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
870812-- Reading.
871813
872814t_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)
874816 where t = T.dropWhile isDigit s
875817tl_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)
877819 where t = TL.dropWhile isDigit s
878820t_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)
880822 where t = T.dropWhile isHexDigit s
881823 p = if ox then "0x" else ""
882824 n = getPositive m :: Int
883825tl_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)
885827 where t = TL.dropWhile isHexDigit s
886828 p = if ox then "0x" else ""
887829 n = getPositive m :: Int
@@ -925,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
925867
926868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927869t_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
929871 where n = small m
930872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
931873
932−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
933875
934876-- Regression tests.
935877s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -982,15 +924,6 @@ tests =
982924 testGroup "errors" [
983925 testProperty "t_utf8_err" t_utf8_err,
984926 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
994927 ]
995928 ],
996929
@@ -1034,8 +967,6 @@ tests =
1034967 testProperty "sf_uncons" sf_uncons,
1035968 testProperty "t_uncons" t_uncons,
1036969 testProperty "tl_uncons" tl_uncons,
1037− testProperty "t_unsnoc" t_unsnoc,
1038− testProperty "tl_unsnoc" tl_unsnoc,
1039970 testProperty "s_head" s_head,
1040971 testProperty "sf_head" sf_head,
1041972 testProperty "t_head" t_head,
@@ -1099,9 +1030,7 @@ tests =
10991030 testProperty "tl_toLower_lower" tl_toLower_lower,
11001031 testProperty "t_toUpper_length" t_toUpper_length,
11011032 testProperty "t_toUpper_upper" t_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
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
11051034 ],
11061035
11071036 testGroup "justification" [
@@ -1218,9 +1147,7 @@ tests =
12181147 testProperty "t_takeWhile" t_takeWhile,
12191148 testProperty "tl_takeWhile" tl_takeWhile,
12201149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
12221150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
12241151 testProperty "sf_dropWhile" sf_dropWhile,
12251152 testProperty "s_dropWhile" s_dropWhile,
12261153 testProperty "s_dropWhile_s" s_dropWhile_s,