Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs

Previously the `integer-gmp` variant of `isValidNatural` would fail to
detect values `<= maxBound::Word` that were incorrectly encoded using
the `NatJ#` constructor.

6 files changed, 20 insertions, 1 deletions

diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs
index b452d5119d..93c67b6c7a 100644
--- a/libraries/base/GHC/Natural.hs
+++ b/libraries/base/GHC/Natural.hs
@@ -157,7 +157,9 @@ data Natural = NatS#                 GmpLimb# -- ^ in @[0, maxBound::Word]@
 isValidNatural :: Natural -> Bool
 isValidNatural (NatS# _)  = True
 isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
-                            && isTrue# (sizeofBigNat# bn ># 0#)
+                            -- A 1-limb BigNat could fit into a NatS#, so we
+                            -- require at least 2 limbs.
+                            && isTrue# (sizeofBigNat# bn ># 1#)
 
 signumNatural :: Natural -> Natural
 signumNatural (NatS# 0##) = NatS# 0##
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 6da0c70b36..a9f6fcf272 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -5,6 +5,10 @@
 
   * Add a `TestEquality` instance for the `Compose` newtype.
 
+  * Fix the `integer-gmp` variant of `isValidNatural`: Previously it would fail
+    to detect values `<= maxBound::Word` that were incorrectly encoded using
+    the `NatJ#` constructor.
+
 ## 4.13.0.0 *TBA*
   * Bundled with GHC *TBA*
 
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 86c3ec9477..97d3ca4168 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -40,6 +40,7 @@ test('take001', extra_run_opts('1'), compile_and_run, [''])
 test('inits', normal, compile_and_run, [''])
 test('genericNegative001', extra_run_opts('-1'), compile_and_run, [''])
 test('ix001', normal, compile_and_run, [''])
+test('isValidNatural', reqlib('integer-gmp'), compile_and_run, [''])
 
 # need to add -K64m to the compiler opts, so that GHCi gets it too
 test('ioref001',
diff --git a/libraries/base/tests/isValidNatural.hs b/libraries/base/tests/isValidNatural.hs
new file mode 100644
index 0000000000..1b062f0309
--- /dev/null
+++ b/libraries/base/tests/isValidNatural.hs
@@ -0,0 +1,9 @@
+{-# language MagicHash #-}
+
+import GHC.Integer.GMP.Internals
+import GHC.Natural
+
+main = print $ map isValidNatural [0, 1, maxWord, maxWord + 1, invalid]
+  where
+    maxWord = fromIntegral (maxBound :: Word)
+    invalid = NatJ# oneBigNat -- 1 would fit into the NatS# constructor.
diff --git a/libraries/base/tests/isValidNatural.stdout b/libraries/base/tests/isValidNatural.stdout
new file mode 100644
index 0000000000..ccb5c6c2d0
--- /dev/null
+++ b/libraries/base/tests/isValidNatural.stdout
@@ -0,0 +1 @@
+[True,True,True,True,False]
diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index 521cd95a25..14bdb57ffd 100644
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs
@@ -1778,6 +1778,8 @@ foreign import ccall unsafe "gmp.h __gmpn_popcount"
 -- BigNat-wrapped ByteArray#-primops
 
 -- | Return number of limbs contained in 'BigNat'.
+--
+-- The result is always @>= 1@ since even zero is encoded with 1 limb.
 sizeofBigNat# :: BigNat -> GmpSize#
 sizeofBigNat# (BN# x#)
     = sizeofByteArray# x# `uncheckedIShiftRL#` GMP_LIMB_SHIFT#