Add tests for the new ByteArray# <-> Addr# copy primops

Essentially the same tests as for the existing ByteArray# ones.

Signed-off-by: Austin Seipp <austin@well-typed.com>

2 files changed, 103 insertions, 0 deletions

diff --git a/testsuite/tests/codeGen/should_run/cgrun070.hs b/testsuite/tests/codeGen/should_run/cgrun070.hs
index 3187af6f67..a8ac6ad745 100644
--- a/testsuite/tests/codeGen/should_run/cgrun070.hs
+++ b/testsuite/tests/codeGen/should_run/cgrun070.hs
@@ -9,11 +9,16 @@ import GHC.Word
 import GHC.Exts hiding (IsList(..))
 import GHC.Prim
 import GHC.ST
+import GHC.IO
+import GHC.Ptr
 
 main = putStr
        (test_copyByteArray
         ++ "\n" ++ test_copyMutableByteArray
         ++ "\n" ++ test_copyMutableByteArrayOverlap
+        ++ "\n" ++ test_copyByteArrayToAddr
+        ++ "\n" ++ test_copyMutableByteArrayToAddr
+        ++ "\n" ++ test_copyAddrToByteArray
         ++ "\n"
        )
 
@@ -81,6 +86,64 @@ test_copyMutableByteArrayOverlap =
      inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
 
 ------------------------------------------------------------------------
+-- copyByteArrayToAddr#
+
+-- Copy a slice of the source array into a destination memory area and check
+-- that the copy succeeded.
+test_copyByteArrayToAddr :: String
+test_copyByteArrayToAddr =
+    let dst = runST $ do
+            src <- newByteArray len
+            fill src 0 len
+            src <- unsafeFreezeByteArray src
+            withNewPinnedByteArray len $ \dst dst_marr -> do
+              -- Markers to detect errors
+              writeWord8Array dst_marr 0 255
+              writeWord8Array dst_marr (len-1) 255
+              -- Leave the first and last element untouched
+              copyByteArrayToAddr src 1 (dst `plusPtr` 1) copied
+              unsafeFreezeByteArray dst_marr
+    in shows (toList dst len) "\n"
+
+------------------------------------------------------------------------
+-- copyMutableByteArrayToAddr#
+
+-- Copy a slice of the source array into a destination memory area and check
+-- that the copy succeeded.
+test_copyMutableByteArrayToAddr :: String
+test_copyMutableByteArrayToAddr =
+    let dst = runST $ do
+            src <- newByteArray len
+            fill src 0 len
+            withNewPinnedByteArray len $ \dst dst_marr -> do
+              -- Markers to detect errors
+              writeWord8Array dst_marr 0 255
+              writeWord8Array dst_marr (len-1) 255
+              -- Leave the first and last element untouched
+              copyMutableByteArrayToAddr src 1 (dst `plusPtr` 1) copied
+              unsafeFreezeByteArray dst_marr
+    in shows (toList dst len) "\n"
+
+------------------------------------------------------------------------
+-- copyAddrToByteArray#
+
+-- Copy a slice of the source memory area into a destination array and check
+-- that the copy succeeded.
+test_copyAddrToByteArray :: String
+test_copyAddrToByteArray =
+    let dst = runST $
+            withNewPinnedByteArray len $ \src src_marr -> do
+              fill src_marr 0 len
+              dst <- newByteArray len
+              -- Markers to detect errors
+              writeWord8Array dst 0 255
+              writeWord8Array dst (len-1) 255
+              -- Leave the first and last element untouched
+              copyAddrToByteArray (src `plusPtr` 1) dst 1 copied
+              unsafeFreezeByteArray dst
+    in shows (toList dst len) "\n"
+
+------------------------------------------------------------------------
 -- Test helpers
 
 -- Initialize the elements of this array, starting at the given
@@ -112,6 +175,25 @@ newByteArray :: Int -> ST s (MByteArray s)
 newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of
     (# s2#, marr# #) -> (# s2#, MByteArray marr# #)
 
+newPinnedByteArray :: Int -> ST s (Ptr (), MByteArray s)
+newPinnedByteArray (I# n#) = ST $ \s# ->
+    case newPinnedByteArray# n# s# of
+        (# s2#, marr# #) ->
+          (# s2#, (Ptr (byteArrayContents# (unsafeCoerce# marr#)), 
+                  MByteArray marr#) #)
+
+withNewPinnedByteArray :: Int -> (Ptr () -> MByteArray s -> ST s a) -> ST s a
+withNewPinnedByteArray n action = do
+    (ptr, marr) <- newPinnedByteArray n
+    x <- action ptr marr
+    touch marr
+    return x
+
+touch :: a -> ST s ()
+touch a = unsafeIOToST $ IO $ \s# ->
+    case touch# a s# of
+        s2# -> (# s2#, () #)
+
 indexWord8Array :: ByteArray -> Int -> Word8
 indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of
     a -> W8# a
@@ -137,6 +219,21 @@ copyMutableByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
     case copyMutableByteArray# (unMBA src) six# (unMBA dst) dix# n# s# of
         s2# -> (# s2#, () #)
 
+copyAddrToByteArray :: Ptr () -> MByteArray s -> Int -> Int -> ST s ()
+copyAddrToByteArray (Ptr src#) dst (I# dix#) (I# n#) = ST $ \ s# ->
+    case copyAddrToByteArray# src# (unMBA dst) dix# n# s# of
+        s2# -> (# s2#, () #)
+
+copyByteArrayToAddr :: ByteArray -> Int -> Ptr () -> Int -> ST s ()
+copyByteArrayToAddr src (I# six#) (Ptr dst#) (I# n#) = ST $ \ s# ->
+    case copyByteArrayToAddr# (unBA src) six# dst# n# s# of
+        s2# -> (# s2#, () #)
+
+copyMutableByteArrayToAddr :: MByteArray s -> Int -> Ptr () -> Int -> ST s ()
+copyMutableByteArrayToAddr src (I# six#) (Ptr dst#) (I# n#) = ST $ \ s# ->
+    case copyMutableByteArrayToAddr# (unMBA src) six# dst# n# s# of
+        s2# -> (# s2#, () #)
+
 toList :: ByteArray -> Int -> [Word8]
 toList arr n = go 0
   where
diff --git a/testsuite/tests/codeGen/should_run/cgrun070.stdout b/testsuite/tests/codeGen/should_run/cgrun070.stdout
index db95c83d7b..4c62f485cc 100644
--- a/testsuite/tests/codeGen/should_run/cgrun070.stdout
+++ b/testsuite/tests/codeGen/should_run/cgrun070.stdout
@@ -4,3 +4,9 @@
 
 [0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
 
+[255,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,255]
+
+[255,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,255]
+
+[255,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,255]
+