Commit 5f7733d4 authored by Duncan Coutts's avatar Duncan Coutts Committed by Austin Seipp
Browse files

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



Essentially the same tests as for the existing ByteArray# ones.
Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 05d2faec
......@@ -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"
)
......@@ -80,6 +85,64 @@ test_copyMutableByteArrayOverlap =
-- This case was known to fail at some point.
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
......@@ -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
......
......@@ -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]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment