From 4bc7b1e5abaee101198c336ea2ff9c1d0c12149d Mon Sep 17 00:00:00 2001
From: Fraser Tweedale <frase@frase.id.au>
Date: Fri, 21 Jul 2023 23:47:50 +1000
Subject: [PATCH] =?UTF-8?q?numberToRangedRational:=20fix=20edge=20cases=20?=
=?UTF-8?q?for=20exp=20=E2=89=88=20(maxBound=20::=20Int)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Currently a negative exponent less than `minBound :: Int` results in
Infinity, which is very surprising and obviously wrong.
```
λ> read "1e-9223372036854775808" :: Double
0.0
λ> read "1e-9223372036854775809" :: Double
Infinity
```
There is a further edge case where the exponent can overflow when
increased by the number of tens places in the integer part, or
underflow when decreased by the number of leading zeros in the
fractional part if the integer part is zero:
```
λ> read "10e9223372036854775807" :: Double
0.0
λ> read "0.01e-9223372036854775808" :: Double
Infinity
```
To resolve both of these issues, perform all arithmetic and
comparisons involving the exponent in type `Integer`. This approach
also eliminates the need to explicitly check the exponent against
`maxBound :: Int` and `minBound :: Int`, because the allowed range
of the exponent (i.e. the result of `floatRange` for the target
floating point type) is certainly within those bounds.
This change implements CLC proposal 192:
https://github.com/haskell/core-libraries-committee/issues/192
---
libraries/base/Text/Read/Lex.hs | 18 ++++++++---------
libraries/base/changelog.md | 1 +
libraries/base/tests/all.T | 1 +
libraries/base/tests/read-float-double.hs | 20 +++++++++++++++++++
libraries/base/tests/read-float-double.stdout | 8 ++++++++
5 files changed, 38 insertions(+), 10 deletions(-)
create mode 100644 libraries/base/tests/read-float-double.hs
create mode 100644 libraries/base/tests/read-float-double.stdout
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
index 03d22228bb98..ba0c563c513a 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 ae6647eb6849..d63d1fc01612 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 95da992e817d..dfeb95a8f0ed 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 000000000000..628434671e0d
--- /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 000000000000..59cc9b8d199e
--- /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
--
GitLab