@@ -11,7 +11,7 @@ module Tests.Properties
1111import Control.Applicative ((<$>), (<*>))
1212import Control.Arrow ((***), 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)
@@ -37,6 +38,7 @@ import qualified Control.Exception as Exception
3738import qualified Data.Bits as Bits (shiftL, shiftR)
3839import qualified Data.ByteString as B
3940import qualified Data.ByteString.Lazy as BL
41+import qualified Data.Char as C
4042import qualified Data.List as L
4143import qualified Data.Text as T
4244import qualified Data.Text.Encoding as E
@@ -326,6 +328,16 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326328 where p = T.length . T.filter isUpper
327329tl_toUpper_upper t = p (TL.toUpper t) >= p t
328330 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)
339+ -- in Unicode 7.0
340+ stable c = c /= '\170' && c /= '\186'
329341
330342justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331343justifyRight 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
867879
868880t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869881t_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
871883 where n = small m
872884t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873885
@@ -1030,7 +1042,9 @@ tests =
10301042 testProperty "tl_toLower_lower" tl_toLower_lower,
10311043 testProperty "t_toUpper_length" t_toUpper_length,
10321044 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
10341048 ],
10351049
10361050 testGroup "justification" [