blob: 5827640d843812b3fb2c504c739d6c23966fe0de (
plain) (
blame)
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
|
{-# LANGUAGE ScopedTypeVariables #-}
module Tests.Vector.UnitTests (tests) where
import Control.Applicative as Applicative
import qualified Data.Vector.Storable as Storable
import Foreign.Ptr
import Foreign.Storable
import Text.Printf
import Test.Framework
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, assertBool)
newtype Aligned a = Aligned { getAligned :: a }
instance (Storable a) => Storable (Aligned a) where
sizeOf _ = sizeOf (undefined :: a)
alignment _ = 128
peek ptr = Aligned Applicative.<$> peek (castPtr ptr)
poke ptr = poke (castPtr ptr) . getAligned
checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion
checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do
let ptr' = ptrToWordPtr ptr
msg = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr')
align :: WordPtr
align = fromIntegral $ alignment dummy
assertBool msg $ (ptr' `mod` align) == 0
where
dummy :: a
dummy = undefined
tests :: [Test]
tests =
[ testGroup "Data.Vector.Storable.Vector Alignment"
[ testCase "Aligned Double" $
checkAddressAlignment alignedDoubleVec
, testCase "Aligned Int" $
checkAddressAlignment alignedIntVec
]
]
alignedDoubleVec :: Storable.Vector (Aligned Double)
alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
alignedIntVec :: Storable.Vector (Aligned Int)
alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
|
