[commit: testsuite] master: Add test for byte array copy primops (c7f744b)
David Terei
davidterei at gmail.com
Fri Jun 17 06:43:50 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/testsuite
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c7f744bce65cfa2a3d18d9687df889de54333823
>---------------------------------------------------------------
commit c7f744bce65cfa2a3d18d9687df889de54333823
Author: Johan Tibell <johan.tibell at gmail.com>
Date: Tue May 24 00:06:16 2011 +0200
Add test for byte array copy primops
Signed-off-by: David Terei <davidterei at gmail.com>
>---------------------------------------------------------------
tests/ghc-regress/codeGen/should_run/all.T | 1 +
tests/ghc-regress/codeGen/should_run/cgrun069.hs | 1 -
tests/ghc-regress/codeGen/should_run/cgrun070.hs | 144 ++++++++++++++++++++
.../ghc-regress/codeGen/should_run/cgrun070.stdout | 6 +
4 files changed, 151 insertions(+), 1 deletions(-)
diff --git a/tests/ghc-regress/codeGen/should_run/all.T b/tests/ghc-regress/codeGen/should_run/all.T
index 4811388..c5c5829 100644
--- a/tests/ghc-regress/codeGen/should_run/all.T
+++ b/tests/ghc-regress/codeGen/should_run/all.T
@@ -74,6 +74,7 @@ test('cgrun067', extra_clean(['Cgrun067A.hi', 'Cgrun067A.o']),
test('cgrun068', normal, compile_and_run, [''])
test('cgrun069', omit_ways(['ghci']), multisrc_compile_and_run,
['cgrun069', ['cgrun069_cmm.cmm'], ''])
+test('cgrun070', normal, compile_and_run, [''])
test('1852', normal, compile_and_run, [''])
test('1861', extra_run_opts('0'), compile_and_run, [''])
diff --git a/tests/ghc-regress/codeGen/should_run/cgrun069.hs b/tests/ghc-regress/codeGen/should_run/cgrun069.hs
index 0c6bf7a..076abc2 100644
--- a/tests/ghc-regress/codeGen/should_run/cgrun069.hs
+++ b/tests/ghc-regress/codeGen/should_run/cgrun069.hs
@@ -80,4 +80,3 @@ main = do
_ <- evaluate (I# (testMemcpy4_8 1#))
putStrLn "Test Passed!"
return ()
-
diff --git a/tests/ghc-regress/codeGen/should_run/cgrun070.hs b/tests/ghc-regress/codeGen/should_run/cgrun070.hs
new file mode 100644
index 0000000..1f6b562
--- /dev/null
+++ b/tests/ghc-regress/codeGen/should_run/cgrun070.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- !!! simple tests of copying/cloning byte arrays
+--
+
+module Main ( main ) where
+
+import GHC.Word
+import GHC.Exts
+import GHC.Prim
+import GHC.ST
+
+main = putStr
+ (test_copyByteArray
+ ++ "\n" ++ test_copyMutableByteArray
+ ++ "\n" ++ test_copyMutableByteArrayOverlap
+ ++ "\n"
+ )
+
+------------------------------------------------------------------------
+-- Constants
+
+-- All allocated arrays are of this size
+len :: Int
+len = 130
+
+-- We copy these many elements
+copied :: Int
+copied = len - 2
+
+------------------------------------------------------------------------
+-- copyByteArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_copyByteArray :: String
+test_copyByteArray =
+ let dst = runST $ do
+ src <- newByteArray len
+ fill src 0 len
+ src <- unsafeFreezeByteArray src
+ dst <- newByteArray len
+ -- Markers to detect errors
+ writeWord8Array dst 0 255
+ writeWord8Array dst (len-1) 255
+ -- Leave the first and last element untouched
+ copyByteArray src 1 dst 1 copied
+ unsafeFreezeByteArray dst
+ in shows (toList dst len) "\n"
+
+------------------------------------------------------------------------
+-- copyMutableByteArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_copyMutableByteArray :: String
+test_copyMutableByteArray =
+ let dst = runST $ do
+ src <- newByteArray len
+ fill src 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
+ copyMutableByteArray src 1 dst 1 copied
+ unsafeFreezeByteArray dst
+ in shows (toList dst len) "\n"
+
+-- Perform a copy where the source and destination part overlap.
+test_copyMutableByteArrayOverlap :: String
+test_copyMutableByteArrayOverlap =
+ let arr = runST $ do
+ marr <- fromList inp
+ -- Overlap of two elements
+ copyMutableByteArray marr 5 marr 7 8
+ unsafeFreezeByteArray marr
+ in shows (toList arr (length inp)) "\n"
+ where
+ -- 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]
+
+------------------------------------------------------------------------
+-- Test helpers
+
+-- Initialize the elements of this array, starting at the given
+-- offset. The last parameter specifies the number of elements to
+-- initialize. Element at index @i@ takes the value @i@ (i.e. the
+-- first actually modified element will take value @off@).
+fill :: MByteArray s -> Int -> Int -> ST s ()
+fill marr off count = go 0
+ where
+ go i
+ | i >= fromIntegral count = return ()
+ | otherwise = do writeWord8Array marr (off + i) (fromIntegral i)
+ go (i + 1)
+
+fromList :: [Word8] -> ST s (MByteArray s)
+fromList xs0 = do
+ marr <- newByteArray (length xs0)
+ let go [] i = i `seq` return marr
+ go (x:xs) i = writeWord8Array marr i x >> go xs (i + 1)
+ go xs0 0
+
+------------------------------------------------------------------------
+-- Convenience wrappers for ByteArray# and MutableByteArray#
+
+data ByteArray = ByteArray { unBA :: ByteArray# }
+data MByteArray s = MByteArray { unMBA :: MutableByteArray# s }
+
+newByteArray :: Int -> ST s (MByteArray s)
+newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of
+ (# s2#, marr# #) -> (# s2#, MByteArray marr# #)
+
+indexWord8Array :: ByteArray -> Int -> Word8
+indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of
+ a -> W8# a
+
+writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s ()
+writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# ->
+ case writeWord8Array# (unMBA marr) i# a s# of
+ s2# -> (# s2#, () #)
+
+unsafeFreezeByteArray :: MByteArray s -> ST s (ByteArray)
+unsafeFreezeByteArray marr = ST $ \ s# ->
+ case unsafeFreezeByteArray# (unMBA marr) s# of
+ (# s2#, arr# #) -> (# s2#, ByteArray arr# #)
+
+copyByteArray :: ByteArray -> Int -> MByteArray s -> Int -> Int -> ST s ()
+copyByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
+ case copyByteArray# (unBA src) six# (unMBA dst) dix# n# s# of
+ s2# -> (# s2#, () #)
+
+copyMutableByteArray :: MByteArray s -> Int -> MByteArray s -> Int -> Int
+ -> ST s ()
+copyMutableByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
+ case copyMutableByteArray# (unMBA src) six# (unMBA dst) dix# n# s# of
+ s2# -> (# s2#, () #)
+
+toList :: ByteArray -> Int -> [Word8]
+toList arr n = go 0
+ where
+ go i | i >= n = []
+ | otherwise = indexWord8Array arr i : go (i+1)
diff --git a/tests/ghc-regress/codeGen/should_run/cgrun070.stdout b/tests/ghc-regress/codeGen/should_run/cgrun070.stdout
new file mode 100644
index 0000000..db95c83
--- /dev/null
+++ b/tests/ghc-regress/codeGen/should_run/cgrun070.stdout
@@ -0,0 +1,6 @@
+[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]
+
+[0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
+
More information about the Cvs-ghc
mailing list