@@ -9,18 +9,20 @@ module Tests.Properties
12−import Test.QuickCheck
12+import Test.QuickCheck hiding ((.&.))
13import Test.QuickCheck.Monadic
13import Test.QuickCheck.Monadic
14import Text.Show.Functions ()
14import Text.Show.Functions ()
16import Control.Applicative ((<$>), (<*>))
16import Control.Applicative ((<$>), (<*>))
17import Control.Arrow ((***), second)
17import Control.Arrow ((***), second)
18import Control.Exception (catch)
18import Control.Exception (catch)
19+import Data.Bits ((.&.))
19import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
20import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
20import Data.Int (Int8, Int16, Int32, Int64)
21import Data.Int (Int8, Int16, Int32, Int64)
21import Data.Monoid (Monoid(..))
22import Data.Monoid (Monoid(..))
22import Data.String (fromString)
23import Data.String (fromString)
23import Data.Text.Encoding.Error
24import Data.Text.Encoding.Error
25+import Data.Text.Encoding.Utf8
24import Data.Text.Foreign
26import Data.Text.Foreign
25import Data.Text.Fusion.Size
27import Data.Text.Fusion.Size
26import Data.Text.Lazy.Read as TL
28import Data.Text.Lazy.Read as TL
@@ -145,6 +147,11 @@ genInvalidUTF8 = B.pack <$> oneof [
145 (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
147 (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte
146 -- invalid leading byte of a 4-byte sequence
148 -- invalid leading byte of a 4-byte sequence
147 , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte
149 , (:) <$> 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
148 -- continuation bytes without a start byte
155 -- continuation bytes without a start byte
149 , listOf1 contByte
156 , listOf1 contByte
150 -- short 2-byte sequence
157 -- short 2-byte sequence
@@ -153,6 +160,16 @@ genInvalidUTF8 = B.pack <$> oneof [
153 , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
160 , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte
154 -- short 4-byte sequence
161 -- short 4-byte sequence
155 , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
162 , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte
163+ -- overlong encoding
164+ , do k <- choose (0,0xFFFF)
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]
158 contByte = (0x80 +) <$> choose (0, 0x3f)
175 contByte = (0x80 +) <$> choose (0, 0x3f)