Add unit tests for alignment of storable vectors

Author: sergv

tests/Main.hs

@@ -1,12 +1,15 @@
 module Main (main) where
 
 import qualified Tests.Vector
+import qualified Tests.Vector.UnitTests
 import qualified Tests.Bundle
 import qualified Tests.Move
 
 import Test.Framework (defaultMain)
 
+main :: IO ()
 main = defaultMain $ Tests.Bundle.tests
                   ++ Tests.Vector.tests
+                  ++ Tests.Vector.UnitTests.tests
                   ++ Tests.Move.tests
 

tests/Tests/Vector/UnitTests.hs

@@ -0,0 +1,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]

vector.cabal

@@ -188,7 +188,8 @@ test-suite vector-tests-O0
   hs-source-dirs: tests
   Build-Depends: base >= 4 && < 5, template-haskell, vector,
                  random,
-                 QuickCheck >= 2.9 && < 2.10 , test-framework, test-framework-quickcheck2,
+                 QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
+                 test-framework-hunit, test-framework-quickcheck2,
                  transformers >= 0.2.0.0
 
   default-extensions: CPP,
@@ -217,7 +218,8 @@ test-suite vector-tests-O2
   hs-source-dirs: tests
   Build-Depends: base >= 4 && < 5, template-haskell, vector,
                  random,
-                 QuickCheck >= 2.9 && < 2.10 , test-framework, test-framework-quickcheck2,
+                 QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
+                 test-framework-hunit, test-framework-quickcheck2,
                  transformers >= 0.2.0.0
 
   default-extensions: CPP,