Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4226bae42fdd666c15190ac2f8784547d3fbad5f >--------------------------------------------------------------- commit 4226bae42fdd666c15190ac2f8784547d3fbad5f Author: Paolo Capriotti <[email protected]> Date: Mon Jul 2 12:54:57 2012 +0100 Fix parsing of RealFloat with huge exponents (#7034). Ensure numberToRangedRational returns Nothing immediately if the exponent is outside Int range, so that we avoid an integer overflow later. >--------------------------------------------------------------- Text/Read/Lex.hs | 8 +++++++- tests/T7034.hs | 11 +++++++++++ tests/T7034.stdout | 6 ++++++ tests/all.T | 2 +- 4 files changed, 25 insertions(+), 2 deletions(-) diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 1a163ee..7c99f0c 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -44,7 +44,7 @@ import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum ) import GHC.Real( Integral, Rational, (%), fromIntegral, toInteger, (^) ) import GHC.List -import GHC.Enum( maxBound ) +import GHC.Enum( minBound, maxBound ) #else import Prelude hiding ( lex ) import Data.Char( chr, ord, isSpace, isAlpha, isAlphaNum ) @@ -96,6 +96,12 @@ numberToInteger _ = Nothing numberToRangedRational :: (Int, Int) -> Number -> Maybe Rational -- Nothing = Inf numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp)) + -- if exp is out of integer bounds, + -- then the number is definitely out of range + | exp > fromIntegral (maxBound :: Int) || + exp < fromIntegral (minBound :: Int) + = Nothing + | otherwise = let mFirstDigit = case dropWhile (0 ==) iPart of iPart'@(_ : _) -> Just (length iPart') [] -> case mFPart of diff --git a/tests/T7034.hs b/tests/T7034.hs new file mode 100644 index 0000000..b862bd8 --- /dev/null +++ b/tests/T7034.hs @@ -0,0 +1,11 @@ +main :: IO () +main = do + print $ r "1E100000" + print $ r "1E100000000" + print $ r "1E100000000000" + print $ r "1E100000000000000" + print $ r "1E100000000000000000" + print $ r "1E100000000000000000000" + +r :: String -> Double +r = read diff --git a/tests/T7034.stdout b/tests/T7034.stdout new file mode 100644 index 0000000..2675153 --- /dev/null +++ b/tests/T7034.stdout @@ -0,0 +1,6 @@ +Infinity +Infinity +Infinity +Infinity +Infinity +Infinity diff --git a/tests/all.T b/tests/all.T index aaa476c..b7a1629 100644 --- a/tests/all.T +++ b/tests/all.T @@ -118,4 +118,4 @@ test('4006', if_msys(expect_fail), compile_and_run, ['']) test('5943', normal, compile_and_run, ['']) test('T5962', normal, compile_and_run, ['']) - +test('T7034', normal, compile_and_run, ['']) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
