diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 03d22228bb9852a0654c7c1561566d1142410ab8..ba0c563c513ad79c99ff8f0549a59d108eb9cb98 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -47,7 +47,7 @@ import GHC.Unicode import GHC.Real( Rational, (%), fromIntegral, Integral, toInteger, (^), quot, even ) import GHC.List -import GHC.Enum( minBound, maxBound ) +import GHC.Enum( maxBound ) import Data.Maybe -- local copy to break import-cycle @@ -121,12 +121,9 @@ numberToFixed _ _ = 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 + -- Calculate amount to increase/decrease the exponent, based on (non + -- leading zero) places in the iPart, or leading zeros in the fPart. + -- If iPart and fPart are all zeros, return Nothing. = let mFirstDigit = case dropWhile (0 ==) iPart of iPart'@(_ : _) -> Just (length iPart') [] -> case mFPart of @@ -139,10 +136,11 @@ numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp)) in case mFirstDigit of Nothing -> Just 0 Just firstDigit -> - let firstDigit' = firstDigit + fromInteger exp - in if firstDigit' > (pos + 3) + -- compare exp to bounds as Integer to avoid over/underflow + let firstDigit' = toInteger firstDigit + exp + in if firstDigit' > toInteger (pos + 3) then Nothing - else if firstDigit' < (neg - 3) + else if firstDigit' < toInteger (neg - 3) then Just 0 else Just (numberToRational n) numberToRangedRational _ n = Just (numberToRational n) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index ae6647eb6849204d34caa7c71b30a8741b6b6d6b..d63d1fc016124541028f5a8afafba3f231578934 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -38,6 +38,7 @@ * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) + * Fixed exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 95da992e817d273343e1104fe4bf189aee1f4111..dfeb95a8f0edb7b1f1064fd0fed3daf13b2abae5 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -14,6 +14,7 @@ def normalise_quotes (str): #-------------------------------------- test('SystemInfoTest', normal, compile_and_run, ['']) test('readFloat', exit_code(1), compile_and_run, ['']) +test('read-float-double', normal, compile_and_run, ['']) test('enumDouble', normal, compile_and_run, ['']) test('enumRatio', normal, compile_and_run, ['']) test('enumNumeric', normal, compile_and_run, ['']) diff --git a/libraries/base/tests/read-float-double.hs b/libraries/base/tests/read-float-double.hs new file mode 100644 index 0000000000000000000000000000000000000000..628434671e0dd51d926154ea0718fc5c821a1052 --- /dev/null +++ b/libraries/base/tests/read-float-double.hs @@ -0,0 +1,20 @@ +-- Test edge cases fixed in +-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10933 + +main :: IO () +main = do + let + lo = toInteger (minBound :: Int) + hi = toInteger (maxBound :: Int) + readDouble = read :: String -> Double + readFloat = read :: String -> Float + + print $ readDouble ("1e" <> show lo) + print $ readDouble ("1e" <> show (lo - 1)) + print $ readDouble ("0.01e" <> show lo) + print $ readDouble ("10e" <> show hi) + + print $ readFloat ("1e" <> show lo) + print $ readFloat ("1e" <> show (lo - 1)) + print $ readFloat ("0.01e" <> show lo) + print $ readFloat ("10e" <> show hi) diff --git a/libraries/base/tests/read-float-double.stdout b/libraries/base/tests/read-float-double.stdout new file mode 100644 index 0000000000000000000000000000000000000000..59cc9b8d199eed5fd88d47e2d2294ca416eb4ea6 --- /dev/null +++ b/libraries/base/tests/read-float-double.stdout @@ -0,0 +1,8 @@ +0.0 +0.0 +0.0 +Infinity +0.0 +0.0 +0.0 +Infinity