@@ -13,6 +13,7 @@ import Test.QuickCheck
1313import Test.QuickCheck.Monadic
1414import Text.Show.Functions ()
1515
16+import Control.Applicative ((<$>), (<*>))
1617import Control.Arrow ((***), second)
1718import Control.Exception (catch)
1819import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
@@ -93,23 +94,55 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
9394t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
9495tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
9596
96−-- This is a poor attempt to ensure that the error handling paths on
97−-- decode are exercised in some way. Proper testing would be rather
98−-- more involved.
99−t_utf8_err :: DecodeErr -> B.ByteString -> Property
100−t_utf8_err (DE _ de) bs = monadicIO $ do
101− l <- run $ let len = T.length (E.decodeUtf8With de bs)
102− in (len `seq` return (Right len)) `catch`
103− (\(e::UnicodeException) -> return (Left e))
104− case l of
105− Left err -> assert $ length (show err) >= 0
106− Right n -> assert $ n >= 0
97+data Badness = Solo | Leading | Trailing
98+ deriving (Eq, Show)
99+
100+instance Arbitrary Badness where
101+ arbitrary = elements [Solo, Leading, Trailing]
102+
103+t_utf8_err :: Badness -> DecodeErr -> Property
104+t_utf8_err bad de = do
105+ let gen = case bad of
106+ Solo -> genInvalidUTF8
107+ Leading -> B.append <$> genInvalidUTF8 <*> genUTF8
108+ Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8
109+ genUTF8 = E.encodeUtf8 <$> genUnicode
110+ forAll gen $ \bs -> do
111+ onErr <- genDecodeErr de
112+ monadicIO $ do
113+ l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
114+ in (len `seq` return (Right len)) `catch`
115+ (\(e::UnicodeException) -> return (Left e))
116+ assert $ case l of
117+ Left err -> length (show err) >= 0
118+ Right _ -> de /= Strict
107119
108120t_utf8_err' :: B.ByteString -> Property
109121t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
110122 Left err -> length (show err) >= 0
111123 Right t -> T.length t >= 0
112124
125+genInvalidUTF8 :: Gen B.ByteString
126+genInvalidUTF8 = B.pack <$> oneof [
127+ -- invalid leading byte of a 2-byte sequence
128+ (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
129+ -- invalid leading byte of a 4-byte sequence
130+ , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
131+ -- continuation bytes without a start byte
132+ , listOf1 contByte
133+ -- short 2-byte sequence
134+ , (:[]) <$> choose (0xC2, 0xDF)
135+ -- short 3-byte sequence
136+ , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
137+ -- short 4-byte sequence
138+ , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
139+ ]
140+ where
141+ contByte = (0x80 +) <$> choose (0, 0x3f)
142+ upTo n gen = do
143+ k <- choose (0,n)
144+ vectorOf k gen
145+
113146s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
114147 where _types = s :: String
115148sf_Eq p s =