diff --git a/Data/Text.hs b/Data/Text.hs index fa7a2e4f0b00be72e000056803668e0666274139..23c4a1408e6ee7a041cb72a34a300337fe94a2ef 100644 --- a/Data/Text.hs +++ b/Data/Text.hs @@ -807,6 +807,8 @@ replicate n t@(Text a o l) | n <= 0 || l <= 0 = empty | n == 1 = t | isSingleton t = replicateChar n (unsafeHead t) + | len < n = error $ "Data.Text.replicate: invalid length " ++ + show n -- multiplication overflow | otherwise = Text (A.run x) 0 len where len = l * n diff --git a/Data/Text/Array.hs b/Data/Text/Array.hs index 59135ec5ef5be14492c17c32b9b96811e316f7b3..87a62ae9c28c8a81e30efad23910c78e0280deca 100644 --- a/Data/Text/Array.hs +++ b/Data/Text/Array.hs @@ -103,7 +103,7 @@ instance IArray (MArray s) where -- | Create an uninitialized mutable array. new :: forall s. Int -> ST s (MArray s) new n - | len < 0 = error $ "Data.Text.Array.unsafeNew: invalid length " ++ show n + | len < n = error $ "Data.Text.Array.unsafeNew: invalid length " ++ show n | otherwise = ST $ \s1# -> case newByteArray# len# s1# of (# s2#, marr# #) -> (# s2#, MArray marr# diff --git a/tests/Regressions.hs b/tests/Regressions.hs index 83a0bc2991bfd17522e5fbb863a91dcbcdcd79ee..93242f97ee52c91cf0fcc27678dbc9ff426b0637 100644 --- a/tests/Regressions.hs +++ b/tests/Regressions.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} -- Regression tests for specific bugs. @@ -6,6 +6,7 @@ import Control.Exception (SomeException, handle) import System.IO import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LE @@ -30,10 +31,21 @@ hGetContents_crash = withTempFile $ \ path h -> do handle (\(_::SomeException) -> return ()) $ T.hGetContents h' >> assertFailure "T.hGetContents should crash" +-- Reported by Ian Lynagh: attempting to allocate a sufficiently large +-- string (via either Array.new or Text.replicate) could result in an +-- integer overflow. +replicate_crash = handle (\(_::SomeException) -> return ()) $ + T.replicate (2^power) "0123456789abcdef" `seq` + assertFailure "T.replicate should crash" + where + power | maxBound == (2147483647::Int) = 28 + | otherwise = 60 :: Int + tests :: F.Test tests = F.testGroup "crashers" [ F.testCase "hGetContents_crash" hGetContents_crash , F.testCase "lazy_encode_crash" lazy_encode_crash + , F.testCase "replicate_crash" replicate_crash ] main = F.defaultMain [tests] diff --git a/text.cabal b/text.cabal index 45b9c11389db6b5ac118fb30f113b94b5001dda8..c052a6f74b4d34f19d2c5b10909dda53da2962d6 100644 --- a/text.cabal +++ b/text.cabal @@ -1,5 +1,5 @@ name: text -version: 0.9.0.2 +version: 0.9.0.1 homepage: http://code.haskell.org/text synopsis: An efficient packed Unicode text type. description: