git.iko.soy/text
on master help sign in
Ensure that t_utf8_err gets fed *only* invalid UTF-8 inputs
9c11b44Bryan O'Sullivan
tests/Tests/Properties.hs+44−11
compare with master
unifiedsplit
@@ -13,6 +13,7 @@ import Test.QuickCheck
13import Test.QuickCheck.Monadic
13import Test.QuickCheck.Monadic
14import Text.Show.Functions ()
14import Text.Show.Functions ()
15
15
16+import Control.Applicative ((<$>), (<*>))
16import Control.Arrow ((***), second)
17import Control.Arrow ((***), second)
17import Control.Exception (catch)
18import Control.Exception (catch)
18import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
19import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
@@ -93,23 +94,55 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id
93t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
94t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id
94tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
95tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id
95
96
96−-- This is a poor attempt to ensure that the error handling paths on
97+data Badness = Solo | Leading | Trailing
97−-- decode are exercised in some way. Proper testing would be rather
98+ deriving (Eq, Show)
98−-- more involved.
99+
100+instance Arbitrary Badness where
101+ arbitrary = elements [Solo, Leading, Trailing]
102+
99−t_utf8_err :: DecodeErr -> B.ByteString -> Property
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
100−t_utf8_err (DE _ de) bs = monadicIO $ do
112+ monadicIO $ do
101− l <- run $ let len = T.length (E.decodeUtf8With de bs)
113+ l <- run $ let len = T.length (E.decodeUtf8With onErr bs)
102− in (len `seq` return (Right len)) `catch`
114+ in (len `seq` return (Right len)) `catch`
103− (\(e::UnicodeException) -> return (Left e))
115+ (\(e::UnicodeException) -> return (Left e))
104− case l of
116+ assert $ case l of
105− Left err -> assert $ length (show err) >= 0
117+ Left err -> length (show err) >= 0
106− Right n -> assert $ n >= 0
118+ Right _ -> de /= Strict
107
119
108t_utf8_err' :: B.ByteString -> Property
120t_utf8_err' :: B.ByteString -> Property
109t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
121t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of
110 Left err -> length (show err) >= 0
122 Left err -> length (show err) >= 0
111 Right t -> T.length t >= 0
123 Right t -> T.length t >= 0
112
124
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+
113s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
146s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
114 where _types = s :: String
147 where _types = s :: String
115sf_Eq p s =
148sf_Eq p s =
tests/Tests/QuickCheckUtils.hs+9−7
@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils
18 , integralRandomR
18 , integralRandomR
19
19
20 , DecodeErr (..)
20 , DecodeErr (..)
21+ , genDecodeErr
21
22
22 , Stringy (..)
23 , Stringy (..)
23 , eq
24 , eq
@@ -194,16 +195,17 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
194 fromIntegral b :: Integer) g of
195 fromIntegral b :: Integer) g of
195 (x,h) -> (fromIntegral x, h)
196 (x,h) -> (fromIntegral x, h)
196
197
197−data DecodeErr = DE String T.OnDecodeError
198+data DecodeErr = Lenient | Ignore | Strict | Replace
199+ deriving (Show, Eq)
198
200
199−instance Show DecodeErr where
201+genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
200− show (DE d _) = "DE " ++ d
202+genDecodeErr Lenient = return T.lenientDecode
203+genDecodeErr Ignore = return T.ignore
204+genDecodeErr Strict = return T.strictDecode
205+genDecodeErr Replace = arbitrary
201
206
202instance Arbitrary DecodeErr where
207instance Arbitrary DecodeErr where
203− arbitrary = oneof [ return $ DE "lenient" T.lenientDecode
208+ arbitrary = elements [Lenient, Ignore, Strict, Replace]
204− , return $ DE "ignore" T.ignore
205− , return $ DE "strict" T.strictDecode
206− , DE "replace" `fmap` arbitrary ]
207
209
208class Stringy s where
210class Stringy s where
209 packS :: String -> s
211 packS :: String -> s