fromEnum Natural: Throw error for non-representable values

Starting with commit fe770c21, an error was thrown only for the values
2^63 to 2^64-1 inclusive (on a 64-bit machine), but not for higher
values. Now, errors are thrown for all non-representable values again.

Fixes #20291

3 files changed, 56 insertions, 0 deletions

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, [''])