@@ -11,7 +11,7 @@ module Tests.Properties
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12import Control.Arrow ((***), second)
12import 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)
@@ -38,7 +37,6 @@ import qualified Control.Exception as Exception
38import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
39import qualified Data.ByteString as B
38import qualified Data.ByteString as B
40import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
41−import qualified Data.Char as C
42import qualified Data.List as L
40import qualified Data.List as L
43import qualified Data.Text as T
41import qualified Data.Text as T
44import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
@@ -62,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
62tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
63t_stream_unstream = (S.unstream . S.stream) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
64tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
65−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
66−t_singleton c = [c] === (T.unpack . T.singleton) c
64+t_singleton c = [c] == (T.unpack . T.singleton) c
67−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
68−tl_unstreamChunks x = f 11 x === f 1000 x
66+tl_unstreamChunks x = f 11 x == f 1000 x
69 where f n = SL.unstreamChunks n . S.streamList
67 where f n = SL.unstreamChunks n . S.streamList
70tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
71tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -76,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
76encodeLazyL1 :: TL.Text -> BL.ByteString
74encodeLazyL1 :: TL.Text -> BL.ByteString
77encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
79−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
80 where a = T.map (\c -> chr (ord c `mod` 128)) t
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
81−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
79+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
82 where a = TL.map (\c -> chr (ord c `mod` 128)) t
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
83−t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
84 where a = T.map (\c -> chr (ord c `mod` 256)) t
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
85−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
86 where a = TL.map (\c -> chr (ord c `mod` 256)) t
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
87t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
88t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -113,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
113 let b = E.encodeUtf8 t
111 let b = E.encodeUtf8 t
114 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
115 leftover = (++ [B.empty]) . init . tail . B.inits
113 leftover = (++ [B.empty]) . init . tail . B.inits
116− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
118data Badness = Solo | Leading | Trailing
116data Badness = Solo | Leading | Trailing
119 deriving (Eq, Show)
117 deriving (Eq, Show)
@@ -203,8 +201,8 @@ t_mconcat = unsquare $
203 mconcat `eq` (unpackS . mconcat . L.map T.pack)
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
204tl_mconcat = unsquare $
202tl_mconcat = unsquare $
205 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
206−t_mempty = mempty === (unpackS (mempty :: T.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
207−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
208t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
209tl_IsString = fromString `eqP` (TL.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
@@ -328,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
328 where p = T.length . T.filter isUpper
326 where p = T.length . T.filter isUpper
329tl_toUpper_upper t = p (TL.toUpper t) >= p t
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
330 where p = TL.length . TL.filter isUpper
328 where p = TL.length . TL.filter isUpper
331−t_toTitle_title t = all (<= 1) (caps w)
332− where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
333− -- TIL: there exist uppercase-only letters
334− w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
335−t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
336− where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
337− -- Surprise! The Spanish/Portuguese ordinal indicators changed
338− -- from category Ll (letter, lowercase) to Lo (letter, other)
340− -- Oh, and there exist lowercase-only letters (see previous test)
341− stable c = if isLower c
342− then C.toUpper c /= c
343− else c /= '\170' && c /= '\186'
345justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
346justifyRight m n xs = L.replicate (m - length xs) n ++ xs
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -735,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
735 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
736t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
737 let s = T.intercalate t ts
722 let s = T.intercalate t ts
738− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
740-- Bit shifts.
725-- Bit shifts.
741shiftL 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
@@ -827,18 +812,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
827-- Reading.
812-- Reading.
829t_decimal (n::Int) s =
814t_decimal (n::Int) s =
830− 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)
831 where t = T.dropWhile isDigit s
816 where t = T.dropWhile isDigit s
832tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
833− 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)
834 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
835t_hexadecimal m s ox =
820t_hexadecimal m s ox =
836− 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)
837 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
838 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
839 n = getPositive m :: Int
824 n = getPositive m :: Int
840tl_hexadecimal m s ox =
825tl_hexadecimal m s ox =
841− 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)
842 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
843 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
844 n = getPositive m :: Int
829 n = getPositive m :: Int
@@ -882,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
883t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
884t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
885−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
886 where n = small m
871 where n = small m
887t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
889−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
891-- Regression tests.
876-- Regression tests.
892s_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)
@@ -1045,9 +1030,7 @@ tests =
1045 testProperty "tl_toLower_lower" tl_toLower_lower,
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1046 testProperty "t_toUpper_length" t_toUpper_length,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1047 testProperty "t_toUpper_upper" t_toUpper_upper,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1048− testProperty "tl_toUpper_upper" tl_toUpper_upper,
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
1049− testProperty "t_toTitle_title" t_toTitle_title,
1050− testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1053 testGroup "justification" [
1036 testGroup "justification" [