diff --git a/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs b/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs index 8a65c00f165ed11273c16d11708fee653f7fedb4..98eea981eaf6678b9cefaa1dccdff221eb894690 100644 --- a/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs +++ b/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs @@ -103,7 +103,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize (T bs (S3 b c d) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done - consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st + consume (T Empty _ i) = decodeError "streamUtf8" "UTF-8" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf8 #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little @@ -143,7 +143,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize (T bs (S3 w2 w3 w4) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done - consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st + consume (T Empty _ i) = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf16LE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big @@ -183,7 +183,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize (T bs (S3 w2 w3 w4) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done - consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st + consume (T Empty _ i) = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf16BE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big @@ -227,7 +227,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize (T bs (S3 w2 w3 w4) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done - consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st + consume (T Empty _ i) = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf32BE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little @@ -271,7 +271,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize (T bs (S3 w2 w3 w4) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done - consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st + consume (T Empty _ i) = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf32LE #-} -- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'. diff --git a/tests/Tests/Regressions.hs b/tests/Tests/Regressions.hs index cf0116809f2113bdbe25d7a05db95f91f617cefb..14fcbaf630b37828870998d6318c2af56209b335 100644 --- a/tests/Tests/Regressions.hs +++ b/tests/Tests/Regressions.hs @@ -23,6 +23,8 @@ import qualified Data.Text.Array as TA import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Internal as T +import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E +import qualified Data.Text.Internal.Lazy.Fusion as LF import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TB @@ -30,6 +32,7 @@ import qualified Data.Text.Lazy.Encoding as LE import qualified Data.Text.Unsafe as T import qualified Test.Tasty as F import qualified Test.Tasty.HUnit as F +import Test.Tasty.HUnit ((@?=)) import System.Directory (removeFile) import Tests.Utils (withTempFile) @@ -145,6 +148,16 @@ t330 = do (decodeL (LB.fromChunks [B.pack [194], B.pack [97, 98, 99]])) (decodeL (LB.fromChunks [B.pack [194, 97, 98, 99]])) +-- Stream decoders should not loop on incomplete code points +t525 :: IO () +t525 = do + let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs) + decodeUtf8With E.lenientDecode "\xC0" @?= "\65533" + LE.decodeUtf16BEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf16LEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf32BEWith E.lenientDecode "\0" @?= "\65533" + LE.decodeUtf32LEWith E.lenientDecode "\0" @?= "\65533" + tests :: F.TestTree tests = F.testGroup "Regressions" [ F.testCase "hGetContents_crash" hGetContents_crash @@ -159,4 +172,5 @@ tests = F.testGroup "Regressions" , F.testCase "t280/singleton" t280_singleton , F.testCase "t301" t301 , F.testCase "t330" t330 + , F.testCase "t525" t525 ]