text 1.0.0.0 → 1.0.0.1
raw patch · 5 files changed
+108/−30 lines, 5 files
Files
- cbits/cbits.c +31/−10
- changelog +5/−0
- tests/Tests/Properties.hs +62/−12
- tests/Tests/QuickCheckUtils.hs +9/−7
- text.cabal +1/−1
cbits/cbits.c view
@@ -127,11 +127,18 @@ * state0 != UTF8_ACCEPT, UTF8_REJECT * */-const uint8_t *-_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,- const uint8_t **const src,- const uint8_t *const srcend,- uint32_t *codepoint0, uint32_t *state0)+#if defined(__GNUC__) || defined(__clang__)+static inline uint8_t const *+_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,+ const uint8_t const **src, const uint8_t const *srcend,+ uint32_t *codepoint0, uint32_t *state0)+ __attribute((always_inline));+#endif++static inline uint8_t const *+_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,+ const uint8_t const **src, const uint8_t const *srcend,+ uint32_t *codepoint0, uint32_t *state0) { uint16_t *d = dest + *destoff; const uint8_t *s = *src, *last = *src;@@ -185,10 +192,6 @@ last = s; } - /* Invalid encoding, back up to the errant character */- if (state == UTF8_REJECT)- s -= 1;- *destoff = d - dest; *codepoint0 = codepoint; *state0 = state;@@ -197,6 +200,19 @@ return s; } +uint8_t const *+_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,+ const uint8_t const **src,+ const uint8_t const *srcend,+ uint32_t *codepoint0, uint32_t *state0)+{+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,+ codepoint0, state0);+ if (*state0 == UTF8_REJECT)+ ret -=1;+ return ret;+}+ /* * Helper to decode buffer and discard final decoder state */@@ -206,5 +222,10 @@ { uint32_t codepoint; uint32_t state = UTF8_ACCEPT;- return _hs_text_decode_utf8_state(dest, destoff, &src, srcend, &codepoint, &state);+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,+ &codepoint, &state);+ /* Back up if we have an incomplete or invalid encoding */+ if (state != UTF8_ACCEPT)+ ret -= 1;+ return ret; }
changelog view
@@ -1,3 +1,8 @@+1.0.0.1++ * decodeUtf8: Fixed a regression that caused us to incorrectly+ identify truncated UTF-8 as valid (gh-61)+ 1.0.0.0 * Added support for Unicode 6.3.0 to case conversion functions
tests/Tests/Properties.hs view
@@ -9,17 +9,20 @@ tests ) where -import Test.QuickCheck+import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Monadic import Text.Show.Functions () +import Control.Applicative ((<$>), (<*>)) import Control.Arrow ((***), second) import Control.Exception (catch)+import Data.Bits ((.&.)) import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord) import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (Monoid(..)) import Data.String (fromString) import Data.Text.Encoding.Error+import Data.Text.Encoding.Utf8 import Data.Text.Foreign import Data.Text.Fusion.Size import Data.Text.Lazy.Read as TL@@ -110,22 +113,69 @@ E.Some t _ f' = f a in t : feedChunksOf n f' b --- This is a poor attempt to ensure that the error handling paths on--- decode are exercised in some way. Proper testing would be rather--- more involved.-t_utf8_err :: DecodeErr -> B.ByteString -> Property-t_utf8_err (DE _ de) bs = monadicIO $ do- l <- run $ let len = T.length (E.decodeUtf8With de bs)- in (len `seq` return (Right len)) `catch`- (\(e::UnicodeException) -> return (Left e))- case l of- Left err -> assert $ length (show err) >= 0- Right n -> assert $ n >= 0+data Badness = Solo | Leading | Trailing+ deriving (Eq, Show) +instance Arbitrary Badness where+ arbitrary = elements [Solo, Leading, Trailing]++t_utf8_err :: Badness -> DecodeErr -> Property+t_utf8_err bad de = do+ let gen = case bad of+ Solo -> genInvalidUTF8+ Leading -> B.append <$> genInvalidUTF8 <*> genUTF8+ Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8+ genUTF8 = E.encodeUtf8 <$> genUnicode+ forAll gen $ \bs -> do+ onErr <- genDecodeErr de+ monadicIO $ do+ l <- run $ let len = T.length (E.decodeUtf8With onErr bs)+ in (len `seq` return (Right len)) `catch`+ (\(e::UnicodeException) -> return (Left e))+ assert $ case l of+ Left err -> length (show err) >= 0+ Right _ -> de /= Strict+ t_utf8_err' :: B.ByteString -> Property t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of Left err -> length (show err) >= 0 Right t -> T.length t >= 0++genInvalidUTF8 :: Gen B.ByteString+genInvalidUTF8 = B.pack <$> oneof [+ -- invalid leading byte of a 2-byte sequence+ (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte+ -- invalid leading byte of a 4-byte sequence+ , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte+ -- 4-byte sequence greater than U+10FFFF+ , do k <- choose (0x11, 0x1F)+ let w0 = 0xF0 + (k `Bits.shiftR` 2)+ w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)+ ([w0,w1]++) <$> vectorOf 2 contByte+ -- continuation bytes without a start byte+ , listOf1 contByte+ -- short 2-byte sequence+ , (:[]) <$> choose (0xC2, 0xDF)+ -- short 3-byte sequence+ , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte+ -- short 4-byte sequence+ , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte+ -- overlong encoding+ , do k <- choose (0,0xFFFF)+ let c = chr k+ case k of+ _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]+ , let (w,x,y) = ord3 c in return [w,x,y]+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]+ | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]+ , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]+ | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]+ ]+ where+ contByte = (0x80 +) <$> choose (0, 0x3f)+ upTo n gen = do+ k <- choose (0,n)+ vectorOf k gen s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList) where _types = s :: String
tests/Tests/QuickCheckUtils.hs view
@@ -18,6 +18,7 @@ , integralRandomR , DecodeErr (..)+ , genDecodeErr , Stringy (..) , eq@@ -194,16 +195,17 @@ fromIntegral b :: Integer) g of (x,h) -> (fromIntegral x, h) -data DecodeErr = DE String T.OnDecodeError+data DecodeErr = Lenient | Ignore | Strict | Replace+ deriving (Show, Eq) -instance Show DecodeErr where- show (DE d _) = "DE " ++ d+genDecodeErr :: DecodeErr -> Gen T.OnDecodeError+genDecodeErr Lenient = return T.lenientDecode+genDecodeErr Ignore = return T.ignore+genDecodeErr Strict = return T.strictDecode+genDecodeErr Replace = arbitrary instance Arbitrary DecodeErr where- arbitrary = oneof [ return $ DE "lenient" T.lenientDecode- , return $ DE "ignore" T.ignore- , return $ DE "strict" T.strictDecode- , DE "replace" `fmap` arbitrary ]+ arbitrary = elements [Lenient, Ignore, Strict, Replace] class Stringy s where packS :: String -> s
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 1.0.0.0+version: 1.0.0.1 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.