Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c7f744bce65cfa2a3d18d9687df889de54333823 >--------------------------------------------------------------- commit c7f744bce65cfa2a3d18d9687df889de54333823 Author: Johan Tibell <[email protected]> Date: Tue May 24 00:06:16 2011 +0200 Add test for byte array copy primops Signed-off-by: David Terei <[email protected]> >--------------------------------------------------------------- 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] + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
