summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDanDoel <>2017-03-13 14:24:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-03-13 14:24:00 (GMT)
commit995d57e68ec9b8982753aa95ac031547fd4762a1 (patch)
tree825886ab084496d5859c361d935e8e2b727c1028
parente31c156cb41eaa09e45bb02206bc841c0623a615 (diff)
version 0.12.0.1HEAD0.12.0.1master
-rw-r--r--Data/Vector/Generic.hs10
-rw-r--r--changelog5
-rw-r--r--tests/Tests/Vector/UnitTests.hs48
-rw-r--r--vector.cabal23
4 files changed, 78 insertions, 8 deletions
diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs
index 0e02214..066c07f 100644
--- a/Data/Vector/Generic.hs
+++ b/Data/Vector/Generic.hs
@@ -228,7 +228,7 @@ import qualified Data.Traversable as T (Traversable(mapM))
-- | /O(1)/ Yield the length of the vector
length :: Vector v a => v a -> Int
{-# INLINE length #-}
-length = Bundle.length . stream
+length = Bundle.length . stream'
-- | /O(1)/ Test whether a vector is empty
null :: Vector v a => v a -> Bool
@@ -1995,7 +1995,13 @@ unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch"
-- | /O(1)/ Convert a vector to a 'Bundle'
stream :: Vector v a => v a -> Bundle v a
{-# INLINE_FUSED stream #-}
-stream v = Bundle.fromVector v
+stream v = stream' v
+
+-- Same as 'stream', but can be used to avoid having a cycle in the dependency
+-- graph of functions, which forces GHC to create a loop breaker.
+stream' :: Vector v a => v a -> Bundle v a
+{-# INLINE stream' #-}
+stream' v = Bundle.fromVector v
{-
stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n)
diff --git a/changelog b/changelog
index 83e48d4..3d824b7 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,8 @@
+Changes in version 0.12.0.1
+
+ * Make sure `length` can be inlined
+ * Include modules that test-suites depend on in other-modules
+
Changes in version 0.12.0.0
* Documentation fixes/additions
diff --git a/tests/Tests/Vector/UnitTests.hs b/tests/Tests/Vector/UnitTests.hs
new file mode 100644
index 0000000..5827640
--- /dev/null
+++ b/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]
diff --git a/vector.cabal b/vector.cabal
index 8f0b57f..38c957d 100644
--- a/vector.cabal
+++ b/vector.cabal
@@ -1,5 +1,5 @@
Name: vector
-Version: 0.12.0.0
+Version: 0.12.0.1
-- don't forget to update the changelog file!
License: BSD3
License-File: LICENSE
@@ -50,11 +50,6 @@ Extra-Source-Files:
tests/LICENSE
tests/Setup.hs
tests/Main.hs
- tests/Boilerplater.hs
- tests/Utilities.hs
- tests/Tests/Move.hs
- tests/Tests/Bundle.hs
- tests/Tests/Vector.hs
benchmarks/vector-benchmarks.cabal
benchmarks/LICENSE
benchmarks/Setup.hs
@@ -183,6 +178,14 @@ test-suite vector-tests-O0
Default-Language: Haskell2010
type: exitcode-stdio-1.0
Main-Is: Main.hs
+
+ other-modules: Boilerplater
+ Tests.Bundle
+ Tests.Move
+ Tests.Vector
+ Tests.Vector.UnitTests
+ Utilities
+
hs-source-dirs: tests
Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
random,
@@ -213,6 +216,14 @@ test-suite vector-tests-O2
Default-Language: Haskell2010
type: exitcode-stdio-1.0
Main-Is: Main.hs
+
+ other-modules: Boilerplater
+ Tests.Bundle
+ Tests.Move
+ Tests.Vector
+ Tests.Vector.UnitTests
+ Utilities
+
hs-source-dirs: tests
Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
random,