From 98252859097c1323d17ffa4bdb14380b05d1fd8c Mon Sep 17 00:00:00 2001
From: Bryan O'Sullivan <bos@serpentine.com>
Date: Mon, 4 Oct 2010 02:50:46 +0000
Subject: [PATCH] Properly fix the int overflow bug reported by Ian
--HG--
extra : convert_revision : 0748b2807e5ea77269050ae6c744df455988a808
---
Data/Text.hs | 2 ++
Data/Text/Array.hs | 2 +-
tests/Regressions.hs | 14 +++++++++++++-
text.cabal | 2 +-
4 files changed, 17 insertions(+), 3 deletions(-)
diff --git a/Data/Text.hs b/Data/Text.hs
index fa7a2e4f..23c4a140 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 59135ec5..87a62ae9 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 83a0bc29..93242f97 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 45b9c113..c052a6f7 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:
--
GitLab