Commit 7896bd50 authored by tibbe's avatar tibbe Committed by Simon Marlow
Browse files

Add test for array copy/clone primops

parent 971a81e9
......@@ -71,6 +71,7 @@ test('cgrun060',
test('cgrun061', normal, compile_and_run, [''])
test('cgrun062', normal, compile_and_run, [''])
test('cgrun063', normal, compile_and_run, [''])
test('cgrun064', normal, compile_and_run, [''])
test('cgrun065', normal, compile_and_run, [''])
test('cgrun066', normal, compile_and_run, [''])
test('cgrun067', extra_clean(['Cgrun067A.hi', 'Cgrun067A.o']),
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- !!! simple tests of copying/cloning primitive arrays
--
module Main ( main ) where
import GHC.Exts
import GHC.Prim
import GHC.ST
main = putStr
(test_copyArray
++ "\n" ++ test_copyMutableArray
++ "\n" ++ test_copyMutableArrayOverlap
++ "\n" ++ test_cloneArray
++ "\n" ++ test_cloneMutableArray
++ "\n" ++ test_cloneMutableArrayEmpty
++ "\n" ++ test_freezeArray
++ "\n" ++ test_thawArray
++ "\n"
)
------------------------------------------------------------------------
-- Constants
-- All allocated arrays are of this size
len :: Int
len = 130
-- We copy these many elements
copied :: Int
copied = len - 2
------------------------------------------------------------------------
-- copyArray#
-- Copy a slice of the source array into a destination array and check
-- that the copy succeeded.
test_copyArray :: String
test_copyArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
src <- unsafeFreezeArray src
dst <- newArray len (-1)
-- Leave the first and last element untouched
copyArray src 1 dst 1 copied
unsafeFreezeArray dst
in shows (toList dst len) "\n"
------------------------------------------------------------------------
-- copyMutableArray#
-- Copy a slice of the source array into a destination array and check
-- that the copy succeeded.
test_copyMutableArray :: String
test_copyMutableArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
dst <- newArray len (-1)
-- Leave the first and last element untouched
copyMutableArray src 1 dst 1 copied
unsafeFreezeArray dst
in shows (toList dst len) "\n"
-- Perform a copy where the source and destination part overlap.
test_copyMutableArrayOverlap :: String
test_copyMutableArrayOverlap =
let arr = runST $ do
marr <- fromList inp
-- Overlap of two elements
copyMutableArray marr 5 marr 7 8
unsafeFreezeArray 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]
------------------------------------------------------------------------
-- cloneArray#
-- Clone a slice of the source array into a destination array and
-- check that the clone succeeded.
test_cloneArray :: String
test_cloneArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
src <- unsafeFreezeArray src
-- Don't include the first and last element.
return $ cloneArray src 1 copied
in shows (toList dst copied) "\n"
------------------------------------------------------------------------
-- cloneMutableArray#
-- Clone a slice of the source array into a destination array and
-- check that the clone succeeded.
test_cloneMutableArray :: String
test_cloneMutableArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
-- Don't include the first and last element.
dst <- cloneMutableArray src 1 copied
unsafeFreezeArray dst
in shows (toList dst copied) "\n"
-- Check that zero-length clones work.
test_cloneMutableArrayEmpty :: String
test_cloneMutableArrayEmpty =
let dst = runST $ do
src <- newArray len 0
dst <- cloneMutableArray src 0 0
unsafeFreezeArray dst
in shows (toList dst 0) "\n"
------------------------------------------------------------------------
-- freezeArray#
-- Clone a slice of the source array into a destination array and
-- check that the clone succeeded.
test_freezeArray :: String
test_freezeArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
-- Don't include the first and last element.
freezeArray src 1 copied
in shows (toList dst copied) "\n"
------------------------------------------------------------------------
-- thawArray#
-- Clone a slice of the source array into a destination array and
-- check that the clone succeeded.
test_thawArray :: String
test_thawArray =
let dst = runST $ do
src <- newArray len 0
fill src 0 len
src <- unsafeFreezeArray src
-- Don't include the first and last element.
dst <- thawArray src 1 copied
unsafeFreezeArray dst
in shows (toList dst copied) "\n"
------------------------------------------------------------------------
-- 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@ (i.e. the
-- first actually modified element will take value @off*off@).
fill :: MArray s Int -> Int -> Int -> ST s ()
fill marr off count = go 0
where
go i
| i >= count = return ()
| otherwise = writeArray marr (off + i) (i*i) >> go (i + 1)
fromList :: [Int] -> ST s (MArray s Int)
fromList xs0 = do
marr <- newArray (length xs0) bottomElem
let go [] i = i `seq` return marr
go (x:xs) i = writeArray marr i x >> go xs (i + 1)
go xs0 0
where
bottomElem = error "undefined element"
------------------------------------------------------------------------
-- Convenience wrappers for Array# and MutableArray#
data Array a = Array { unArray :: Array# a }
data MArray s a = MArray { unMArray :: MutableArray# s a }
newArray :: Int -> a -> ST s (MArray s a)
newArray (I# n#) a = ST $ \s# -> case newArray# n# a s# of
(# s2#, marr# #) -> (# s2#, MArray marr# #)
indexArray :: Array a -> Int -> a
indexArray arr (I# i#) = case indexArray# (unArray arr) i# of
(# a #) -> a
writeArray :: MArray s a -> Int -> a -> ST s ()
writeArray marr (I# i#) a = ST $ \ s# ->
case writeArray# (unMArray marr) i# a s# of
s2# -> (# s2#, () #)
unsafeFreezeArray :: MArray s a -> ST s (Array a)
unsafeFreezeArray marr = ST $ \ s# ->
case unsafeFreezeArray# (unMArray marr) s# of
(# s2#, arr# #) -> (# s2#, Array arr# #)
copyArray :: Array a -> Int -> MArray s a -> Int -> Int -> ST s ()
copyArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
case copyArray# (unArray src) six# (unMArray dst) dix# n# s# of
s2# -> (# s2#, () #)
copyMutableArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()
copyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
case copyMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of
s2# -> (# s2#, () #)
cloneArray :: Array a -> Int -> Int -> Array a
cloneArray src (I# six#) (I# n#) = Array (cloneArray# (unArray src) six# n#)
cloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)
cloneMutableArray src (I# six#) (I# n#) = ST $ \ s# ->
case cloneMutableArray# (unMArray src) six# n# s# of
(# s2#, marr# #) -> (# s2#, MArray marr# #)
freezeArray :: MArray s a -> Int -> Int -> ST s (Array a)
freezeArray src (I# six#) (I# n#) = ST $ \ s# ->
case freezeArray# (unMArray src) six# n# s# of
(# s2#, arr# #) -> (# s2#, Array arr# #)
thawArray :: Array a -> Int -> Int -> ST s (MArray s a)
thawArray src (I# six#) (I# n#) = ST $ \ s# ->
case thawArray# (unArray src) six# n# s# of
(# s2#, marr# #) -> (# s2#, MArray marr# #)
toList :: Array a -> Int -> [a]
toList arr n = go 0
where
go i | i >= n = []
| otherwise = indexArray arr i : go (i+1)
[-1,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,-1]
[-1,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,-1]
[0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
[]
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
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