Add tests for new import/export GMP primitives

Signed-off-by: Herbert Valerio Riedel <hvr@gnu.org>

2 files changed, 147 insertions, 22 deletions

diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs
index b6b90d72e9..1cbad60b7b 100644
--- a/testsuite/tests/lib/integer/integerGmpInternals.hs
+++ b/testsuite/tests/lib/integer/integerGmpInternals.hs
@@ -3,16 +3,34 @@
 module Main (main) where
 
 import Data.List (group)
+import Data.Bits
+import Data.Word
+import Control.Monad
 
+import GHC.Word
 import GHC.Base
-import GHC.Integer
-import GHC.Integer.GMP.Internals
+import GHC.Integer.GMP.Internals (Integer(S#,J#))
+import qualified GHC.Integer.GMP.Internals as I
 
-gcdExtInteger' :: Integer -> Integer -> (Integer, Integer)
-gcdExtInteger' a b = case gcdExtInteger a b of (# a, b #) -> (a,b)
+gcdExtInteger :: Integer -> Integer -> (Integer, Integer)
+gcdExtInteger a b = case I.gcdExtInteger a b of (# a, b #) -> (a,b)
 
-powInteger' :: Integer -> Word -> Integer
-powInteger' b (W# w#) = powInteger b w#
+powInteger :: Integer -> Word -> Integer
+powInteger b (W# w#) = I.powInteger b w#
+
+exportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
+exportInteger i mba o e = IO $ \s -> case I.exportIntegerToMutableByteArray i mba o e s of
+                                         (# s', l #) -> (# s', W# l #)
+
+exportIntegerAddr :: Integer -> Addr# -> Int# -> IO Word
+exportIntegerAddr i a e = IO $ \s -> case I.exportIntegerToAddr i a e s of
+                                         (# s', l #) -> (# s', W# l #)
+
+importInteger = I.importIntegerFromByteArray
+
+importIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer
+importIntegerAddr a l e = IO $ \s -> case I.importIntegerFromAddr a l e s of
+                                         (# s', i #) -> (# s', i #)
 
 {- Reference implementation for 'powModInteger'
 
@@ -31,24 +49,102 @@ powModIntegerHs b0 e0 m
 
 -}
 
+-- helpers
+data MBA = MBA { unMBA :: !(MutableByteArray# RealWorld) }
+data BA  = BA  { unBA  :: !ByteArray# }
+
+newByteArray :: Word# -> IO MBA
+newByteArray sz = IO $ \s -> case newPinnedByteArray# (word2Int# sz) s of (# s, arr #) -> (# s, MBA arr #)
+
+indexByteArray :: ByteArray# -> Word# -> Word8
+indexByteArray a# n# = W8# (indexWord8Array# a# (word2Int# n#))
+
+-- indexMutableByteArray :: MutableByteArray# RealWorld -> Word# -> IO Word8
+-- indexMutableByteArray a# n# = IO $ \s -> case readWord8Array# a# (word2Int# n#) s of (# s', v #) -> (# s', W# v #)
+
+writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
+writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i w s of s -> (# s, () #)
+
+lengthByteArray :: ByteArray# -> Word
+lengthByteArray ba = W# (int2Word# (sizeofByteArray# ba))
+
+unpackByteArray :: ByteArray# -> [Word8]
+unpackByteArray ba | n == 0    = []
+                   | otherwise = [ indexByteArray ba i | W# i <- [0 .. n-1] ]
+  where
+    n = lengthByteArray ba
+
+freezeByteArray :: MutableByteArray# RealWorld -> IO BA
+freezeByteArray arr = IO $ \s -> case unsafeFreezeByteArray# arr s of (# s, arr #) -> (# s, BA arr #)
+
+----------------------------------------------------------------------------
 main :: IO ()
 main = do
-    print $ powModInteger b e m
-    print $ powModInteger b e (m-1)
-    print $ powModSecInteger b e (m-1)
-    print $ gcdExtInteger' b e
-    print $ gcdExtInteger' e b
-    print $ gcdExtInteger' x y
-    print $ gcdExtInteger' y x
-    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 $ nextPrimeInteger b
-    print $ nextPrimeInteger e
-    print $ [ k | k <- [ 0 .. 200 ], S# (testPrimeInteger k 25#) `elem` [1,2] ]
-    print $ rle [ S# (testPrimeInteger k 25#) | k <- [ x .. x + 1000 ] ]
-    print $ rle [ S# (testPrimeInteger k 25#) | k <- [ e .. e + 1000 ] ]
+    print $ I.powModInteger b e m
+    print $ I.powModInteger b e (m-1)
+    print $ I.powModSecInteger b e (m-1)
+    print $ gcdExtInteger b e
+    print $ gcdExtInteger e b
+    print $ gcdExtInteger x y
+    print $ gcdExtInteger y x
+    print $ powInteger 12345 0
+    print $ powInteger 12345 1
+    print $ powInteger 12345 30
+    print $ [ (x,i) | x <- [0..71], let i = 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] ]
+    print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ x .. x + 1000 ] ]
+    print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ e .. e + 1000 ] ]
+
+    -- import/export primitives
+    print $ [ W# (I.sizeInBaseInteger x 2#)   | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
+    print $ [ W# (I.sizeInBaseInteger x 256#) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
+
+    BA ba <- do
+        MBA mba <- newByteArray 128##
+        forM_ (zip [0..127] [0x01..]) $ \(I# i, w) -> do
+            writeByteArray mba i w
+
+        let a = byteArrayContents# (unsafeCoerce# mba)
+
+        print =<< importIntegerAddr a 0## 1#
+        print =<< importIntegerAddr a 0## -1#
+
+        print =<< importIntegerAddr (plusAddr# a 22#)  1## 1#
+        print =<< importIntegerAddr (plusAddr# a 97#) 1## -1#
+
+        print =<< importIntegerAddr a 23## 1#
+        print =<< importIntegerAddr a 23## -1#
+
+        -- no-op
+        print =<< exportIntegerAddr 0 (plusAddr# a 0#) 1#
+
+        -- write into array
+        print =<< exportIntegerAddr b (plusAddr# a 5#) 1#
+        print =<< exportIntegerAddr e (plusAddr# a 50#) -1#
+
+        print =<< exportInteger m mba 85## 1#
+        print =<< exportInteger m mba 105## -1#
+
+        print =<< importIntegerAddr (plusAddr# a 85#)  17## 1#
+        print =<< importIntegerAddr (plusAddr# a 105#) 17## -1#
+
+        -- read back full array
+        print =<< importIntegerAddr a 128## 1#
+        print =<< importIntegerAddr a 128## -1#
+
+        freezeByteArray mba
+
+    print $ importInteger ba 0## 0## 1#
+    print $ importInteger ba 0## 0## -1#
+
+    print $ importInteger ba 5## 29## 1#
+    print $ importInteger ba 50## 29## -1#
+
+    print $ importInteger ba 0## 128## 1#
+    print $ importInteger ba 0## 128## -1#
+
     return ()
   where
     b = 2988348162058574136915891421498819466320163312926952423791023078876139
@@ -58,4 +154,10 @@ main = do
     x = 5328841272400314897981163497728751426
     y = 32052182750761975518649228050096851724
 
+    b1024 = roll (map fromIntegral (take 128 [0x80::Int .. ]))
+
     rle = map (\x -> (length x, head x)) . group
+
+
+    roll :: [Word8] -> Integer
+    roll = foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0
diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout
index be0caab160..e5cf7f6280 100644
--- a/testsuite/tests/lib/integer/integerGmpInternals.stdout
+++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout
@@ -14,3 +14,26 @@
 [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]
 [(25,0),(1,1),(261,0),(1,1),(107,0),(1,1),(49,0),(1,1),(27,0),(1,1),(137,0),(1,1),(49,0),(1,1),(53,0),(1,1),(29,0),(1,1),(39,0),(1,1),(89,0),(1,1),(37,0),(1,1),(21,0),(1,1),(65,0)]
 [(132,0),(1,1),(75,0),(1,1),(551,0),(1,1),(240,0)]
+[1024,462,231,231,133,123,125,1,1,1]
+[128,58,29,29,17,16,16,1,1,1]
+0
+0
+23
+98
+96533667595335344311200144916688449305687896108635671
+2211224323355650230628428319497894791908413370238435841
+0
+29
+29
+17
+17
+10000000000000000000000000000000000000000
+10000000000000000000000000000000000000000
+707742318444110103305827088411305224215218021152567828572343353092273367732652472104598447612703966897013552405105205876531601836257828210094490315227838577315748169688646574531637174201439439064925789856330017827636213265611406915545853552494091915984057391978052737382104710796773315503272295152589111168
+90234380974657405463028074067522969606037220156164619283324346812591427336112251623694808896617626909786308083717091973493080700973825257532066851290431513505598597494043683887914929676998461181716680655771798101377425376141764430298850251302214681051036129537825969557396995822791626849336007688291942072833
+0
+0
+2988348162058574136915891421498819466320163312926952423791023078876139
+2351399303373464486466122544523690094744975233415544072992656881240319
+707742318444110103305827088411305224215218021152567828572343353092273367732652472104598447612703966897013552405105205876531601836257828210094490315227838577315748169688646574531637174201439439064925789856330017827636213265611406915545853552494091915984057391978052737382104710796773315503272295152589111168
+90234380974657405463028074067522969606037220156164619283324346812591427336112251623694808896617626909786308083717091973493080700973825257532066851290431513505598597494043683887914929676998461181716680655771798101377425376141764430298850251302214681051036129537825969557396995822791626849336007688291942072833