diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index d603bc30..e80332d6 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -165,7 +165,7 @@ module Data.Vector.Generic ( liftShowsPrec, liftReadsPrec, -- ** @Data@ and @Typeable@ - gfoldl, gunfold, dataCast, mkVecType, mkVecConstr + gfoldl, gunfold, dataCast, mkVecType, mkVecConstr, mkType ) where import Data.Vector.Generic.Base @@ -212,8 +212,7 @@ import Data.Typeable ( Typeable1, gcast1 ) #include "vector.h" import Data.Data ( Data, DataType, Constr, Fixity(Prefix), - mkDataType, mkConstr, constrIndex ) - + mkDataType, mkConstr, constrIndex, mkNoRepType ) import qualified Data.Traversable as T (Traversable(mapM)) -- Length information @@ -2209,6 +2208,11 @@ mkVecType :: String -> DataType {-# INLINE mkVecType #-} mkVecType name = mkDataType name [mkVecConstr name] +mkType :: String -> DataType +{-# INLINE mkType #-} +{-# DEPRECATED mkType "Use Data.Data.mkNoRepType" #-} +mkType = mkNoRepType + gunfold :: (Vector v a, Data a) => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) diff --git a/changelog.md b/changelog.md index c4a77282..0342fc6f 100644 --- a/changelog.md +++ b/changelog.md @@ -1,22 +1,13 @@ -Changes in version next +# Changes in NEXT_VERSION - * Fix integer overflows in specializations of Bundle/Stream enumFromTo on Integral types - * Fix possibility of OutOfMemory with `take` and very large arguments. - * Fix `slice` function causing segfault and not checking the bounds properly. - * updated specialization rule for EnumFromTo on Float and Double - to make sure it always matches the version in GHC Base (which changed as of 8.6) - Thanks to Aleksey Khudyakov @Shimuuar for this fix. - * fast rejection short circuiting in eqBy operations - * the O2 test suite now has reasonable memory usage on every GHC version, - special thanks to Alexey Kuleshevich (@lehins). + * `mkType` from `Data.Vector.Generic` is deprecated in favor of + `Data.Data.mkNoRepType` * `maximumBy` now behaves like its counterpart in `Data.List` in that if `maximumBy` has to choose between several elements which could be considered the maximum, it will now choose the last element (previously, it would choose the first element). Similarly, `maxIndexBy` will also now pick the last element if several elements could be considered the maximum. - -TODO: should this be in the next release * The role signatures on several `Vector` types were too permissive, so they have been tightened up: * The role signature for `Data.Vector.Mutable.MVector` is now @@ -42,6 +33,24 @@ TODO: should this be in the next release `Data.Vector.Storable{.Mutable}` to allow this (the onus is on the user to ensure that no `Storable` invariants are broken when using these functions). + +# Changes in version 0.12.1.2 + + * Fix for lost function `Data.Vector.Generic.mkType`: [#287](https://github.com/haskell/vector/issues/287) + +# Changes in version 0.12.1.1 (deprecated) + * add semigrioups dep to test suite so CI actually runs again on GHC < 8 + +# Changes in version 0.12.1.0 (deprecated) + * Fix integer overflows in specializations of Bundle/Stream enumFromTo on Integral types + * Fix possibility of OutOfMemory with `take` and very large arguments. + * Fix `slice` function causing segfault and not checking the bounds properly. + * updated specialization rule for EnumFromTo on Float and Double + to make sure it always matches the version in GHC Base (which changed as of 8.6) + Thanks to Aleksey Khudyakov @Shimuuar for this fix. + * fast rejection short circuiting in eqBy operations + * the O2 test suite now has reasonable memory usage on every GHC version, + special thanks to Alexey Kuleshevich (@lehins). * The `Mutable` type family is now injective on GHC 8.0 or later. * Using empty `Storable` vectors no longer results in division-by-zero errors. @@ -53,23 +62,22 @@ TODO: should this be in the next release `All`, `Alt`, and `Compose`. * Add `NFData1` instances for applicable `Vector` types. -Changes in version 0.12.0.3 +# Changes in version 0.12.0.3 * Monad Fail support -Changes in version 0.12.0.2 +# Changes in version 0.12.0.2 * Fixes issue #220, compact heap operations crashing on boxed vectors constructed using traverse. * backport injective type family support * Cleanup the memset code internal to storable vector modules to be compatible with future Primitive releases - -Changes in version 0.12.0.1 +# 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 +# Changes in version 0.12.0.0 * Documentation fixes/additions * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq @@ -81,7 +89,7 @@ Changes in version 0.12.0.0 helper functions. * Relax context for `Unbox (Complex a)`. -Changes in version 0.11.0.0 +# Changes in version 0.11.0.0 * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}` * Define non-bottom `fail` for `instance Monad Vector` @@ -91,50 +99,50 @@ Changes in version 0.11.0.0 - Memory is initialized on creation of unboxed vectors * Changes to SPEC usage to allow building under more conditions -Changes in version 0.10.12.3 +# Changes in version 0.10.12.3 * Allow building with `primtive-0.6` -Changes in version 0.10.12.2 +# Changes in version 0.10.12.2 * Add support for `deepseq-1.4.0.0` -Changes in version 0.10.12.1 +# Changes in version 0.10.12.1 * Fixed compilation on non-head GHCs -Changes in version 0.10.12.0 +# Changes in version 0.10.12.0 * Export MVector constructor from Data.Vector.Primitive to match Vector's (which was already exported). * Fix building on GHC 7.9 by adding Applicative instances for Id and Box -Changes in version 0.10.11.0 +# Changes in version 0.10.11.0 * Support OverloadedLists for boxed Vector in GHC >= 7.8 -Changes in version 0.10.10.0 +# Changes in version 0.10.10.0 * Minor version bump to rectify PVP violation occured in 0.10.9.3 release -Changes in version 0.10.9.3 (deprecated) +# Changes in version 0.10.9.3 (deprecated) * Add support for OverloadedLists in GHC >= 7.8 -Changes in version 0.10.9.2 +# Changes in version 0.10.9.2 * Fix compilation with GHC 7.9 -Changes in version 0.10.9.1 +# Changes in version 0.10.9.1 * Implement poly-kinded Typeable -Changes in version 0.10.0.1 +# Changes in version 0.10.0.1 * Require `primitive` to include workaround for a GHC array copying bug -Changes in version 0.10 +# Changes in version 0.10 * `NFData` instances * More efficient block fills diff --git a/tests/Boilerplater.hs b/tests/Boilerplater.hs index 5506209e..406c1c1e 100644 --- a/tests/Boilerplater.hs +++ b/tests/Boilerplater.hs @@ -1,6 +1,6 @@ module Boilerplater where -import Test.Framework.Providers.QuickCheck2 +import Test.Tasty.QuickCheck import Language.Haskell.TH diff --git a/tests/Main.hs b/tests/Main.hs index 66428883..3dc627f5 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -5,10 +5,10 @@ import qualified Tests.Vector.UnitTests import qualified Tests.Bundle import qualified Tests.Move -import Test.Framework (defaultMain) +import Test.Tasty (defaultMain,testGroup) main :: IO () -main = defaultMain $ Tests.Bundle.tests +main = defaultMain $ testGroup "toplevel" $ Tests.Bundle.tests ++ Tests.Vector.tests ++ Tests.Vector.UnitTests.tests ++ Tests.Move.tests diff --git a/tests/Tests/Bundle.hs b/tests/Tests/Bundle.hs index 9ae85b4b..c6386340 100644 --- a/tests/Tests/Bundle.hs +++ b/tests/Tests/Bundle.hs @@ -7,12 +7,15 @@ import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 +import Test.Tasty +import Test.Tasty.QuickCheck hiding (testProperties) import Text.Show.Functions () import Data.List (foldl', foldl1', unfoldr, find, findIndex) +-- migration from testframework to tasty +type Test = TestTree + #define COMMON_CONTEXT(a) \ VANILLA_CONTEXT(a) diff --git a/tests/Tests/Move.hs b/tests/Tests/Move.hs index 60ea8d33..0c4ee2f1 100644 --- a/tests/Tests/Move.hs +++ b/tests/Tests/Move.hs @@ -1,7 +1,7 @@ module Tests.Move (tests) where import Test.QuickCheck -import Test.Framework.Providers.QuickCheck2 +import Test.Tasty.QuickCheck import Test.QuickCheck.Property (Property(..)) import Utilities () diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs index fdaa7913..5751db43 100644 --- a/tests/Tests/Vector.hs +++ b/tests/Tests/Vector.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector (tests) where -import Test.Framework (testGroup) +import Test.Tasty (testGroup) import qualified Tests.Vector.Boxed import qualified Tests.Vector.Primitive import qualified Tests.Vector.Storable diff --git a/tests/Tests/Vector/Boxed.hs b/tests/Tests/Vector/Boxed.hs index 18ad65bf..d58b9d73 100644 --- a/tests/Tests/Vector/Boxed.hs +++ b/tests/Tests/Vector/Boxed.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Boxed (tests) where -import Test.Framework +import Test.Tasty import qualified Data.Vector import Tests.Vector.Property diff --git a/tests/Tests/Vector/Primitive.hs b/tests/Tests/Vector/Primitive.hs index 5e008fc0..fa1856a7 100644 --- a/tests/Tests/Vector/Primitive.hs +++ b/tests/Tests/Vector/Primitive.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Primitive (tests) where -import Test.Framework +import Test.Tasty import qualified Data.Vector.Primitive import Tests.Vector.Property diff --git a/tests/Tests/Vector/Property.hs b/tests/Tests/Vector/Property.hs index 5d474f05..44414632 100644 --- a/tests/Tests/Vector/Property.hs +++ b/tests/Tests/Vector/Property.hs @@ -20,6 +20,7 @@ module Tests.Vector.Property -- re-exports , Data , Random + ,Test ) where import Boilerplater @@ -29,18 +30,19 @@ import Data.Functor.Identity import qualified Data.Traversable as T (Traversable(..)) import Data.Foldable (Foldable(foldMap)) import Data.Orphans () - +import Data.Monoid import qualified Data.Vector.Generic as V import qualified Data.Vector.Fusion.Bundle as S import Test.QuickCheck -import Test.Framework -import Test.Framework.Providers.QuickCheck2 +import Test.Tasty +import Test.Tasty.QuickCheck hiding (testProperties) import Text.Show.Functions () import Data.List -import Data.Monoid + + import qualified Control.Applicative as Applicative import System.Random (Random) @@ -51,12 +53,17 @@ import Control.Monad.Zip import Data.Data +import qualified Data.List.NonEmpty as DLE +import Data.Semigroup (Semigroup(..)) + type CommonContext a v = (VanillaContext a, VectorContext a v) type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a , TestData a, Model a ~ a, EqTest a ~ Property) type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) +-- | migration hack for moving from TestFramework to Tasty +type Test = TestTree -- TODO: implement Vector equivalents of list functions for some of the commented out properties -- TODO: test and implement some of these other Prelude functions: @@ -514,7 +521,8 @@ testOrdFunctions _ = $(testProperties 'prop_maximum, 'prop_minimum, 'prop_minIndex, 'prop_maxIndex, 'prop_maximumBy, 'prop_minimumBy, - 'prop_maxIndexBy, 'prop_minIndexBy]) + 'prop_maxIndexBy, 'prop_minIndexBy, + 'prop_ListLastMaxIndexWins, 'prop_FalseListFirstMaxIndexWins ]) where prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum @@ -527,9 +535,35 @@ testOrdFunctions _ = $(testProperties not . V.null ===> V.minimumBy compare `eq` minimum prop_maxIndexBy :: P (v a -> Int) = not . V.null ===> V.maxIndexBy compare `eq` maxIndex + prop_ListLastMaxIndexWins :: P (v a -> Int) = + not . V.null ===> ( maxIndex . V.toList) `eq` listMaxIndexLMW + prop_FalseListFirstMaxIndexWinsDesc :: P (v a -> Int) = + (\x -> not $ V.null x && (V.uniq x /= x ) )===> ( maxIndex . V.toList) `eq` listMaxIndexFMW + prop_FalseListFirstMaxIndexWins :: Property + prop_FalseListFirstMaxIndexWins = expectFailure prop_FalseListFirstMaxIndexWinsDesc prop_minIndexBy :: P (v a -> Int) = not . V.null ===> V.minIndexBy compare `eq` minIndex +listMaxIndexFMW :: Ord a => [a] -> Int +listMaxIndexFMW = ( fst . extractFMW . sconcat . DLE.fromList . fmap FMW . zip [0 :: Int ..]) + +listMaxIndexLMW :: Ord a => [a] -> Int +listMaxIndexLMW = ( fst . extractLMW . sconcat . DLE.fromList . fmap LMW . zip [0 :: Int ..]) + +newtype LastMaxWith a i = LMW {extractLMW:: (i,a)} + deriving(Eq,Show,Read) +instance (Ord a) => Semigroup (LastMaxWith a i) where + (<>) x y | snd (extractLMW x) > snd (extractLMW y) = x + | snd (extractLMW x) < snd (extractLMW y) = y + | otherwise = y +newtype FirstMaxWith a i = FMW {extractFMW:: (i,a)} + deriving(Eq,Show,Read) +instance (Ord a) => Semigroup (FirstMaxWith a i) where + (<>) x y | snd (extractFMW x) > snd (extractFMW y) = x + | snd (extractFMW x) < snd (extractFMW y) = y + | otherwise = x + + testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] {-# INLINE testEnumFunctions #-} testEnumFunctions _ = $(testProperties diff --git a/tests/Tests/Vector/Storable.hs b/tests/Tests/Vector/Storable.hs index bf71f14a..1d825e5a 100644 --- a/tests/Tests/Vector/Storable.hs +++ b/tests/Tests/Vector/Storable.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Storable (tests) where -import Test.Framework +import Test.Tasty import qualified Data.Vector.Storable import Tests.Vector.Property diff --git a/tests/Tests/Vector/Unboxed.hs b/tests/Tests/Vector/Unboxed.hs index 2aa0bf8a..6bb55707 100644 --- a/tests/Tests/Vector/Unboxed.hs +++ b/tests/Tests/Vector/Unboxed.hs @@ -1,11 +1,12 @@ {-# LANGUAGE ConstraintKinds #-} module Tests.Vector.Unboxed (tests) where -import Test.Framework +import Test.Tasty import qualified Data.Vector.Unboxed import Tests.Vector.Property + testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [Test] testGeneralUnboxedVector dummy = concatMap ($ dummy) [ diff --git a/tests/Tests/Vector/UnitTests.hs b/tests/Tests/Vector/UnitTests.hs index eefb43f5..162b1aae 100644 --- a/tests/Tests/Vector/UnitTests.hs +++ b/tests/Tests/Vector/UnitTests.hs @@ -20,9 +20,9 @@ import Foreign.Ptr import Foreign.Storable import Text.Printf -import Test.Framework -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion, assertBool, (@=?), assertFailure) +import Test.Tasty +import Test.Tasty.HUnit (testCase,Assertion, assertBool, (@=?), assertFailure) +-- import Test.HUnit () newtype Aligned a = Aligned { getAligned :: a } @@ -43,7 +43,7 @@ checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do dummy :: a dummy = undefined -tests :: [Test] +tests :: [TestTree] tests = [ testGroup "Data.Vector.Storable.Vector Alignment" [ testCase "Aligned Double" $ @@ -83,7 +83,7 @@ tests = ] testsSliceOutOfBounds :: - (Show (v Int), Generic.Vector v Int) => (Int -> Int -> v Int -> v Int) -> [Test] + (Show (v Int), Generic.Vector v Int) => (Int -> Int -> v Int -> v Int) -> [TestTree] testsSliceOutOfBounds sliceWith = [ testCase "Negative ix" $ sliceTest sliceWith (-2) 2 xs , testCase "Negative size" $ sliceTest sliceWith 2 (-2) xs @@ -139,7 +139,7 @@ testTakeOutOfMemory takeWith = regression188 :: forall proxy a. (Typeable a, Enum a, Bounded a, Eq a, Show a) - => proxy a -> Test + => proxy a -> TestTree regression188 _ = testCase (show (typeOf (undefined :: a))) $ Vector.fromList [maxBound::a] @=? Vector.enumFromTo maxBound maxBound {-# INLINE regression188 #-} diff --git a/vector.cabal b/vector.cabal index 573c3ad9..3b796e17 100644 --- a/vector.cabal +++ b/vector.cabal @@ -99,7 +99,6 @@ Flag Wall Manual: True - Library Default-Language: Haskell2010 Other-Extensions: @@ -204,9 +203,9 @@ test-suite vector-tests-O0 hs-source-dirs: tests Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector, primitive, random, - QuickCheck >= 2.9 && < 2.14 , HUnit, test-framework, - test-framework-hunit, test-framework-quickcheck2, - transformers >= 0.2.0.0 + QuickCheck >= 2.9 && < 2.14 , HUnit, tasty, + tasty-hunit, tasty-quickcheck, + transformers >= 0.2.0.0,semigroups default-extensions: CPP, ScopedTypeVariables, @@ -218,7 +217,7 @@ test-suite vector-tests-O0 TypeFamilies, TemplateHaskell - Ghc-Options: -O0 + Ghc-Options: -O0 -threaded Ghc-Options: -Wall if !flag(Wall) @@ -247,9 +246,9 @@ test-suite vector-tests-O2 hs-source-dirs: tests Build-Depends: base >= 4.5 && < 5, template-haskell, base-orphans >= 0.6, vector, primitive, random, - QuickCheck >= 2.9 && < 2.14 , HUnit, test-framework, - test-framework-hunit, test-framework-quickcheck2, - transformers >= 0.2.0.0 + QuickCheck >= 2.9 && < 2.14 , HUnit, tasty, + tasty-hunit, tasty-quickcheck, + transformers >= 0.2.0.0,semigroups default-extensions: CPP, ScopedTypeVariables, @@ -262,7 +261,7 @@ test-suite vector-tests-O2 TemplateHaskell Ghc-Options: -Wall - Ghc-Options: -O2 + Ghc-Options: -O2 -threaded if !flag(Wall) Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures if impl(ghc >= 8.0) && impl(ghc < 8.1)