@@ -9,18 +9,20 @@ module Tests.Properties
99 tests
1010 ) where
1111
12−import Test.QuickCheck
12+import Test.QuickCheck hiding ((.&.))
1313import Test.QuickCheck.Monadic
1414import Text.Show.Functions ()
1515
1616import Control.Applicative ((<$>), (<*>))
1717import Control.Arrow ((***), second)
1818import Control.Exception (catch)
19+import Data.Bits ((.&.))
1920import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
2021import Data.Int (Int8, Int16, Int32, Int64)
2122import Data.Monoid (Monoid(..))
2223import Data.String (fromString)
2324import Data.Text.Encoding.Error
25+import Data.Text.Encoding.Utf8
2426import Data.Text.Foreign
2527import Data.Text.Fusion.Size
2628import Data.Text.Lazy.Read as TL
@@ -145,6 +147,11 @@ genInvalidUTF8 = B.pack <$> oneof [
145147 (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
146148 -- invalid leading byte of a 4-byte sequence
147149 , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
150+ -- 4-byte sequence greater than U+10FFFF
151+ , do k <- choose (0x11, 0x1F)
152+ let w0 = 0xF0 + (k `Bits.shiftR` 2)
153+ w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)
154+ ([w0,w1]++) <$> vectorOf 2 contByte
148155 -- continuation bytes without a start byte
149156 , listOf1 contByte
150157 -- short 2-byte sequence
@@ -153,6 +160,16 @@ genInvalidUTF8 = B.pack <$> oneof [
153160 , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
154161 -- short 4-byte sequence
155162 , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
163+ -- overlong encoding
164+ , do k <- choose (0,0xFFFF)
165+ let c = chr k
166+ case k of
167+ _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]
168+ , let (w,x,y) = ord3 c in return [w,x,y]
169+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
170+ | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]
171+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]
172+ | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]
156173 ]
157174 where
158175 contByte = (0x80 +) <$> choose (0, 0x3f)