Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs
authorSimon Jakobi <simon.jakobi@gmail.com>
Tue, 4 Jun 2019 00:54:35 +0000 (02:54 +0200)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Fri, 7 Jun 2019 14:25:16 +0000 (10:25 -0400)
Previously the `integer-gmp` variant of `isValidNatural` would fail to
detect values `<= maxBound::Word` that were incorrectly encoded using
the `NatJ#` constructor.

libraries/base/GHC/Natural.hs
libraries/base/changelog.md
libraries/base/tests/all.T
libraries/base/tests/isValidNatural.hs [new file with mode: 0644]
libraries/base/tests/isValidNatural.stdout [new file with mode: 0644]
libraries/integer-gmp/src/GHC/Integer/Type.hs

index b452d51..93c67b6 100644 (file)
@@ -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##
index 6da0c70..a9f6fcf 100644 (file)
@@ -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*
 
index 86c3ec9..97d3ca4 100644 (file)
@@ -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 (file)
index 0000000..1b062f0
--- /dev/null
@@ -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 (file)
index 0000000..ccb5c6c
--- /dev/null
@@ -0,0 +1 @@
+[True,True,True,True,False]
index 521cd95..14bdb57 100644 (file)
@@ -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#