diff options
| -rw-r--r-- | libraries/base/GHC/Enum.hs | 6 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 3 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_run/T20291.hs | 45 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_run/T20291.stdout | 9 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_run/all.T | 2 |
5 files changed, 61 insertions, 4 deletions
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 02b3d0e784..2765dcd265 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -967,12 +967,10 @@ instance Enum Natural where | i >= 0 = naturalFromWord# (int2Word# i#) | otherwise = errorWithoutStackTrace "toEnum: unexpected negative Int" - fromEnum (NS w) - | i >= 0 = i - | otherwise = errorWithoutStackTrace "fromEnum: out of Int range" + fromEnum (NS w) | i >= 0 = i where i = I# (word2Int# w) - fromEnum n = fromEnum (integerFromNatural n) + fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range" enumFrom x = enumDeltaNatural x 1 enumFromThen x y diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 7c67e937ba..b71a1fd787 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -13,6 +13,9 @@ * Add `Data.ByteArray` module, providing a boxed `ByteArray#`. + * `fromEnum` for `Natural` now throws an error for any number that cannot be + repesented exactly by an `Int` (#20291). + ## 4.16.0.0 *TBA* * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`. diff --git a/testsuite/tests/numeric/should_run/T20291.hs b/testsuite/tests/numeric/should_run/T20291.hs new file mode 100644 index 0000000000..ab7476f69a --- /dev/null +++ b/testsuite/tests/numeric/should_run/T20291.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE CPP, TypeApplications #-} + +#include "MachDeps.h" + +module Main where + +import Control.Exception +import Numeric.Natural + +ok :: Natural -> IO () +ok n | fromEnum n == i = putStrLn "OK" + | otherwise = putStrLn errmsg + where + i = fromIntegral n + errmsg = ("fromEnum " ++) . shows n . (" == " ++) . shows i $ ": BAD" + +bad :: Natural -> IO () +bad n = do + r <- try @ErrorCall . evaluate $ fromEnum n + case r of + Left _ -> + putStrLn "Exception thrown as expected." + Right _ -> + putStrLn $ + ("fromEnum " ++) . shows n $ ": Exception not thrown when expected." + +main :: IO () +main = do + let sizem2 = WORD_SIZE_IN_BITS - 2 :: Int + sizem1 = WORD_SIZE_IN_BITS - 1 :: Int + size = WORD_SIZE_IN_BITS :: Int + sizep1 = WORD_SIZE_IN_BITS + 1 :: Int + mapM_ ok + [ 0 + , 2 ^ sizem2 + , 2 ^ sizem1 - 1 + ] + mapM_ bad + [ 2 ^ sizem1 + , 2 ^ size - 1 + , 2 ^ size + , 2 ^ size + 2 ^ sizem1 + , 2 ^ sizep1 - 42 + , 2 ^ sizep1 + ] diff --git a/testsuite/tests/numeric/should_run/T20291.stdout b/testsuite/tests/numeric/should_run/T20291.stdout new file mode 100644 index 0000000000..36d05cbe4a --- /dev/null +++ b/testsuite/tests/numeric/should_run/T20291.stdout @@ -0,0 +1,9 @@ +OK +OK +OK +Exception thrown as expected. +Exception thrown as expected. +Exception thrown as expected. +Exception thrown as expected. +Exception thrown as expected. +Exception thrown as expected. diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 1123984bdd..b0580c7e2c 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -77,3 +77,5 @@ test('T18604', normal, compile_and_run, ['']) test('T19931', normal, compile_and_run, ['-O2']) test('IntegerToFloat', normal, compile_and_run, ['']) + +test('T20291', normal, compile_and_run, ['']) |