[commit: ghc] master: Make function intToSBigNat# preserve sign (fixes #14085) (c5605ae)

git at git.haskell.org git at git.haskell.org
Thu Aug 17 20:43:47 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b/ghc

>---------------------------------------------------------------

commit c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b
Author: Olivier Chéron <olivier.cheron at gmail.com>
Date:   Thu Aug 17 10:32:28 2017 -0400

    Make function intToSBigNat# preserve sign (fixes #14085)
    
    Impacts only functions gcdExtInteger, powModInteger and
    recipModInteger which gave invalid results on negative S# inputs.
    
    Also fixes gcdExtInteger assertion when first argument is negative.
    
    Test Plan: Updated test case integerGmpInternals
    
    Reviewers: austin, hvr, goldfire, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14085
    
    Differential Revision: https://phabricator.haskell.org/D3826


>---------------------------------------------------------------

c5605ae00e9bff90db7a5f24ff3b8de2aba3b55b
 libraries/integer-gmp/cbits/wrappers.c                 | 2 +-
 libraries/integer-gmp/src/GHC/Integer/Type.hs          | 2 +-
 testsuite/tests/lib/integer/integerGmpInternals.hs     | 5 ++++-
 testsuite/tests/lib/integer/integerGmpInternals.stdout | 5 ++++-
 4 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c
index c99c017..446a681 100644
--- a/libraries/integer-gmp/cbits/wrappers.c
+++ b/libraries/integer-gmp/cbits/wrappers.c
@@ -312,7 +312,7 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[],
 
   const mp_size_t ssn = s[0]._mp_size;
   const mp_size_t sn  = mp_size_abs(ssn);
-  assert(sn <= xn);
+  assert(sn <= mp_size_abs(xn));
   memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t));
   mpz_clear (s);
 
diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index d5f92b3..952ff6d 100644
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs
@@ -1996,7 +1996,7 @@ intToSBigNat# 0#     = PosBN zeroBigNat
 intToSBigNat# 1#     = PosBN oneBigNat
 intToSBigNat# (-1#)  = NegBN oneBigNat
 intToSBigNat# i# | isTrue# (i# ># 0#) = PosBN (wordToBigNat (int2Word# i#))
-                 | True   = PosBN (wordToBigNat (int2Word# (negateInt# i#)))
+                 | True   = NegBN (wordToBigNat (int2Word# (negateInt# i#)))
 
 -- | Convert 'Integer' into 'SBigNat'
 integerToSBigNat :: Integer -> SBigNat
diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs
index 628f8e0..4edf5d6 100644
--- a/testsuite/tests/lib/integer/integerGmpInternals.hs
+++ b/testsuite/tests/lib/integer/integerGmpInternals.hs
@@ -85,10 +85,13 @@ main = do
     print $ gcdExtInteger e b
     print $ gcdExtInteger x y
     print $ gcdExtInteger y x
+    print $ gcdExtInteger x (-y)
+    print $ gcdExtInteger (-x) y
+    print $ gcdExtInteger (-x) (-y)
     print $ powInteger 12345 0
     print $ powInteger 12345 1
     print $ powInteger 12345 30
-    print $ [ (x,i) | x <- [0..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ]
+    print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ]
     print $ I.nextPrimeInteger b
     print $ I.nextPrimeInteger e
     print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ]
diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout
index e5cf7f6..d5c1374 100644
--- a/testsuite/tests/lib/integer/integerGmpInternals.stdout
+++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout
@@ -5,10 +5,13 @@
 (1,302679100340807588460107986194035692812415103244388831792688023418704)
 (92889294,115110207004456909698806038261)
 (92889294,-19137667681784054624628973533)
+(92889294,115110207004456909698806038261)
+(92889294,-115110207004456909698806038261)
+(92889294,-115110207004456909698806038261)
 1
 12345
 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625
-[(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)]
+[(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)]
 2988348162058574136915891421498819466320163312926952423791023078876343
 2351399303373464486466122544523690094744975233415544072992656881240451
 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199]



More information about the ghc-commits mailing list