@@ -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, 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)
@@ -37,6 +38,7 @@ import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
39import qualified Data.ByteString as B
39import qualified Data.ByteString.Lazy as BL
40import qualified Data.ByteString.Lazy as BL
41+import qualified Data.Char as C
40import qualified Data.List as L
42import qualified Data.List as L
41import qualified Data.Text as T
43import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
44import qualified Data.Text.Encoding as E
@@ -326,6 +328,16 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326 where p = T.length . T.filter isUpper
328 where p = T.length . T.filter isUpper
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
329tl_toUpper_upper t = p (TL.toUpper t) >= p t
328 where p = TL.length . TL.filter isUpper
330 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+ stable c = c /= '\170' && c /= '\186'
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
342justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
343justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -867,7 +879,7 @@ 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
880t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
881t_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
882+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871 where n = small m
883 where n = small m
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
884t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
@@ -1030,7 +1042,9 @@ tests =
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1042 testProperty "tl_toLower_lower" tl_toLower_lower,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1043 testProperty "t_toUpper_length" t_toUpper_length,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1044 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1045+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1046+ testProperty "t_toTitle_title" t_toTitle_title,
1047+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1036 testGroup "justification" [
1050 testGroup "justification" [