1 files changed, 48 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs
new file mode 100644
index 0000000000..5827640d84
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/vector/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]