[commit: testsuite] master: Add tests for the new ByteArray# <-> Addr# copy primops (234404e)
git at git.haskell.org
git at git.haskell.org
Sun Sep 15 22:18:37 CEST 2013
Repository : ssh://git@git.haskell.org/testsuite
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/234404eebaca10e48db02f9d0356c849415f6c90/testsuite
>---------------------------------------------------------------
commit 234404eebaca10e48db02f9d0356c849415f6c90
Author: Duncan Coutts <duncan at community.haskell.org>
Date: Sat Sep 14 10:32:30 2013 +0100
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 at well-typed.com>
>---------------------------------------------------------------
234404eebaca10e48db02f9d0356c849415f6c90
tests/codeGen/should_run/cgrun070.hs | 97 ++++++++++++++++++++++++++++++
tests/codeGen/should_run/cgrun070.stdout | 6 ++
2 files changed, 103 insertions(+)
diff --git a/tests/codeGen/should_run/cgrun070.hs b/tests/codeGen/should_run/cgrun070.hs
index 3187af6..a8ac6ad 100644
--- a/tests/codeGen/should_run/cgrun070.hs
+++ b/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/tests/codeGen/should_run/cgrun070.stdout b/tests/codeGen/should_run/cgrun070.stdout
index db95c83..4c62f48 100644
--- a/tests/codeGen/should_run/cgrun070.stdout
+++ b/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]
+
More information about the ghc-commits
mailing list