on master help sign in
Ensure that an encoding error handler's result is safe
1780bd7Bryan O'Sullivan
Data/Text/Encoding.hs+2−2
@@ -61,7 +61,7 @@ import Data.Bits ((.&.))
61import Data.ByteString as B
61import Data.ByteString as B
62import Data.ByteString.Internal as B
62import Data.ByteString.Internal as B
63import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
63import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
64−import Data.Text.Internal (Text(..), textP)
64+import Data.Text.Internal (Text(..), safe, textP)
65import Data.Text.Private (runText)
65import Data.Text.Private (runText)
66import Data.Text.UnsafeChar (ord, unsafeWrite)
66import Data.Text.UnsafeChar (ord, unsafeWrite)
67import Data.Text.UnsafeShift (shiftL, shiftR)
67import Data.Text.UnsafeShift (shiftL, shiftR)
@@ -130,7 +130,7 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
130 Just c -> do
130 Just c -> do
131 destOff <- peek destOffPtr
131 destOff <- peek destOffPtr
132 w <- unsafeSTToIO $
132 w <- unsafeSTToIO $
133− unsafeWrite dest (fromIntegral destOff) c
133+ unsafeWrite dest (fromIntegral destOff) (safe c)
134 poke destOffPtr (destOff + fromIntegral w)
134 poke destOffPtr (destOff + fromIntegral w)
135 loop $ curPtr' `plusPtr` 1
135 loop $ curPtr' `plusPtr` 1
136 loop (ptr `plusPtr` off)
136 loop (ptr `plusPtr` off)
tests/Tests/Regressions.hs+11−1
@@ -8,10 +8,11 @@ module Tests.Regressions
8
8
9import Control.Exception (SomeException, handle)
9import Control.Exception (SomeException, handle)
10import System.IO
10import System.IO
11−import Test.HUnit (assertFailure)
11+import Test.HUnit (assertBool, assertFailure)
12import qualified Data.ByteString as B
12import qualified Data.ByteString as B
13import qualified Data.ByteString.Lazy as LB
13import qualified Data.ByteString.Lazy as LB
14import qualified Data.Text as T
14import qualified Data.Text as T
15+import qualified Data.Text.Encoding as TE
15import qualified Data.Text.IO as T
16import qualified Data.Text.IO as T
16import qualified Data.Text.Lazy as LT
17import qualified Data.Text.Lazy as LT
17import qualified Data.Text.Lazy.Encoding as LE
18import qualified Data.Text.Lazy.Encoding as LE
@@ -49,9 +50,18 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $
49 power | maxBound == (2147483647::Int) = 28
50 power | maxBound == (2147483647::Int) = 28
50 | otherwise = 60 :: Int
51 | otherwise = 60 :: Int
51
52
53+-- Reported by John Millikin: a UTF-8 decode error handler could
54+-- return a bogus substitution character, which we would write without
55+-- checking.
56+utf8_decode_unsafe :: IO ()
57+utf8_decode_unsafe = do
58+ let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"
59+ assertBool "broken error recovery shouldn't break us" (t == "\xfffd")
60+
52tests :: F.Test
61tests :: F.Test
53tests = F.testGroup "Regressions"
62tests = F.testGroup "Regressions"
54 [ F.testCase "hGetContents_crash" hGetContents_crash
63 [ F.testCase "hGetContents_crash" hGetContents_crash
55 , F.testCase "lazy_encode_crash" lazy_encode_crash
64 , F.testCase "lazy_encode_crash" lazy_encode_crash
56 , F.testCase "replicate_crash" replicate_crash
65 , F.testCase "replicate_crash" replicate_crash
66+ , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
57 ]
67 ]