quickcheck-classes-base 0.6.1.0 → 0.6.2.0
raw patch · 4 files changed
+93/−117 lines, 4 filesdep −base-orphansdep ~transformers
Dependencies removed: base-orphans
Dependency ranges changed: transformers
Files
- changelog.md +6/−0
- quickcheck-classes-base.cabal +15/−12
- src/Test/QuickCheck/Classes/Bifoldable.hs +0/−1
- src/Test/QuickCheck/Classes/Storable.hs +72/−104
changelog.md view
@@ -8,6 +8,12 @@ `quickcheck-classes-base`, changelog entries that deal with any of the classes from `base` are duplicated across the two changelogs. +## [0.6.2.0] - 2021-04-12++- Storable Set-Set Law (resolves issue 101).+- Trim unneeded dependencies (tagged, base-orphans)+- Trim unneeded dependencies on newer GHCs (bifunctors, contravariant)+ ## [0.6.1.0] - 2020-09-09 ### Added - Laws for `abs` and `signum`
quickcheck-classes-base.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.4 name: quickcheck-classes-base-version: 0.6.1.0+version: 0.6.2.0 synopsis: QuickCheck common typeclasses from `base` description: This libary is a minimal variant of `quickcheck-classes` that@@ -20,14 +21,13 @@ but on GHC >= 8.5, it uses `-XQuantifiedConstraints` to express these constraints more cleanly. homepage: https://github.com/andrewthad/quickcheck-classes#readme-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Andrew Martin, chessai maintainer: andrew.thaddeus@gmail.com copyright: 2019 Andrew Martin category: Testing build-type: Simple-cabal-version: >=1.10 extra-source-files: changelog.md flag unary-laws@@ -80,29 +80,32 @@ Test.QuickCheck.Classes.Storable Test.QuickCheck.Classes.Traversable build-depends:- base >= 4.5 && < 5- , base-orphans >= 0.1- , bifunctors- , contravariant+ , base >= 4.5 && < 5 , QuickCheck >= 2.7 , transformers >= 0.3 && < 0.6 , containers >= 0.4.2.1- , tagged- , fail+ if impl(ghc < 8.6)+ build-depends: contravariant+ if impl(ghc < 8.2)+ build-depends: bifunctors if impl(ghc < 8.0)- build-depends: semigroups >= 0.17+ build-depends:+ , semigroups >= 0.17+ , fail+ if impl(ghc < 7.8)+ build-depends: tagged if impl(ghc > 7.4) && impl(ghc < 7.6) build-depends: ghc-prim if impl(ghc > 8.5) cpp-options: -DHAVE_QUANTIFIED_CONSTRAINTS if flag(unary-laws) build-depends:- transformers >= 0.4.0+ , transformers >= 0.4.0 , QuickCheck >= 2.10.0 cpp-options: -DHAVE_UNARY_LAWS if flag(binary-laws) build-depends:- transformers >= 0.5.0+ , transformers >= 0.5.0 , QuickCheck >= 2.10.0 cpp-options: -DHAVE_BINARY_LAWS
src/Test/QuickCheck/Classes/Bifoldable.hs view
@@ -22,7 +22,6 @@ import Data.Functor.Classes (Eq2,Show2) import Test.QuickCheck.Property (Property) import Data.Monoid-import Data.Orphans () import Test.QuickCheck.Classes.Internal #endif
src/Test/QuickCheck/Classes/Storable.hs view
@@ -1,9 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wall #-} @@ -12,21 +8,17 @@ ) where import Control.Applicative+import Control.Monad import Data.Proxy (Proxy) import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Storable- import GHC.Ptr (Ptr(..), plusPtr)-import System.IO.Unsafe import Test.QuickCheck hiding ((.&.))-import Test.QuickCheck.Property (Property) -import qualified Data.List as L- import Test.QuickCheck.Classes.Internal (Laws(..)) --- | Tests the following alternative properties:+-- | Tests the following 'Storable' properties: -- -- [/Set-Get/] -- @('pokeElemOff' ptr ix a >> 'peekElemOff' ptr ix') ≡ 'pure' a@@@ -45,119 +37,95 @@ ] arrayArbitrary :: forall a. (Arbitrary a, Storable a) => Int -> IO (Ptr a)-arrayArbitrary len = do- let go ix xs = if ix == len- then pure xs- else do- x <- generate (arbitrary :: Gen a)- go (ix + 1) (x : xs)- as <- go 0 []- newArray as+arrayArbitrary = newArray <=< generate . vector storablePeekElem :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storablePeekElem _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do- let len = L.length as- ix <- choose (0, len - 1)- return $ unsafePerformIO $ do- addr :: Ptr a <- arrayArbitrary len- x <- peekElemOff addr ix- y <- peek (addr `plusPtr` (ix * sizeOf (undefined :: a)))- free addr- return (x == y)+storablePeekElem _ = property $ \(Positive len) ix' -> ioProperty $ do+ let ix = ix' `mod` len+ addr :: Ptr a <- arrayArbitrary len+ x <- peekElemOff addr ix+ y <- peek (addr `advancePtr` ix)+ free addr+ return (x ==== y) storablePokeElem :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storablePokeElem _ = property $ \(as :: [a]) (x :: a) -> (not (L.null as)) ==> do- let len = L.length as- ix <- choose (0, len - 1)- return $ unsafePerformIO $ do- addr :: Ptr a <- arrayArbitrary len- pokeElemOff addr ix x- u <- peekElemOff addr ix- poke (addr `plusPtr` (ix * sizeOf x)) x- v <- peekElemOff addr ix- free addr- return (u == v)+storablePokeElem _ = property $ \(Positive len) (x :: a) ix' -> ioProperty $ do+ let ix = ix' `mod` len+ addr <- arrayArbitrary len+ pokeElemOff addr ix x+ u <- peekElemOff addr ix+ poke (addr `advancePtr` ix) x+ v <- peekElemOff addr ix+ free addr+ return (u ==== v) storablePeekByte :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storablePeekByte _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do- let len = L.length as- off <- choose (0, len - 1)- return $ unsafePerformIO $ do- addr :: Ptr a <- arrayArbitrary len- x :: a <- peekByteOff addr off- y :: a <- peek (addr `plusPtr` off)- free addr- return (x == y)+storablePeekByte _ = property $ \(Positive len) off' -> ioProperty $ do+ let off = (off' `mod` len) * sizeOf (undefined :: a)+ addr :: Ptr a <- arrayArbitrary len+ x :: a <- peekByteOff addr off+ y :: a <- peek (addr `plusPtr` off)+ free addr+ return (x ==== y) storablePokeByte :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storablePokeByte _ = property $ \(as :: [a]) (x :: a) -> (not (L.null as)) ==> do- let len = L.length as- off <- choose (0, len - 1)- return $ unsafePerformIO $ do- addr :: Ptr a <- arrayArbitrary len- pokeByteOff addr off x- u :: a <- peekByteOff addr off- poke (addr `plusPtr` off) x- v :: a <- peekByteOff addr off- free addr- return (u == v)+storablePokeByte _ = property $ \(Positive len) (x :: a) off' -> ioProperty $ do+ let off = (off' `mod` len) * sizeOf (undefined :: a)+ addr :: Ptr a <- arrayArbitrary len+ pokeByteOff addr off x+ u :: a <- peekByteOff addr off+ poke (addr `plusPtr` off) x+ v :: a <- peekByteOff addr off+ free addr+ return (u ==== v) storableSetGet :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storableSetGet _ = property $ \(a :: a) len -> (len > 0) ==> do- ix <- choose (0,len - 1)- return $ unsafePerformIO $ do- ptr :: Ptr a <- arrayArbitrary len- pokeElemOff ptr ix a- a' <- peekElemOff ptr ix- free ptr- return (a == a')+storableSetGet _ = property $ \(a :: a) (Positive len) ix' -> ioProperty $ do+ let ix = ix' `mod` len+ ptr <- arrayArbitrary len+ pokeElemOff ptr ix a+ a' <- peekElemOff ptr ix+ free ptr+ return (a ==== a') storableGetSet :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storableGetSet _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do- let len = L.length as- ix <- choose (0,len - 1)- return $ unsafePerformIO $ do- ptrA <- newArray as- ptrB <- arrayArbitrary len- copyArray ptrB ptrA len- a <- peekElemOff ptrA ix- pokeElemOff ptrA ix a- res <- arrayEq ptrA ptrB len- free ptrA- free ptrB- return res+storableGetSet _ = property $ \(NonEmpty (as :: [a])) ix' -> ioProperty $ do+ let len = length as+ ix = ix' `mod` len+ ptrA <- newArray as+ ptrB <- arrayArbitrary len+ copyArray ptrB ptrA len+ a <- peekElemOff ptrA ix+ pokeElemOff ptrA ix a + arrA <- peekArray len ptrA+ arrB <- peekArray len ptrB+ free ptrA+ free ptrB+ return $ conjoin $ zipWith (===) arrA arrB+ storableSetSet :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storableSetSet _ = property $ \(x :: a) (y :: a) (as :: [a]) -> (not (L.null as)) ==> do- let len = L.length as- ix <- choose (0,len-1)- return $ unsafePerformIO $ do- ptr <- arrayArbitrary len- pokeElemOff ptr ix x- pokeElemOff ptr ix y- atIx <- peekElemOff ptr ix- free ptr- return $ atIx == y+storableSetSet _ = property $ \(x :: a) (y :: a) (Positive len) ix' -> ioProperty $ do+ let ix = ix' `mod` len+ ptr <- arrayArbitrary len+ pokeElemOff ptr ix x+ pokeElemOff ptr ix y+ atIx <- peekElemOff ptr ix+ free ptr+ return $ atIx ==== y storableList :: forall a. (Storable a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-storableList _ = property $ \(as :: [a]) -> unsafePerformIO $ do- let len = L.length as+storableList _ = property $ \(as :: [a]) -> ioProperty $ do+ let len = length as ptr <- newArray as- let rebuild :: Int -> IO [a]- rebuild !ix = if ix < len+ let rebuild !ix = if ix < len then (:) <$> peekElemOff ptr ix <*> rebuild (ix + 1) else return [] asNew <- rebuild 0 free ptr- return (as == asNew)+ return (as ==== asNew) -arrayEq :: forall a. (Storable a, Eq a) => Ptr a -> Ptr a -> Int -> IO Bool-arrayEq ptrA ptrB len = go 0 where- go !i = if i < len- then do- a <- peekElemOff ptrA i- b <- peekElemOff ptrB i- if a == b- then go (i + 1)- else return False- else return True+(====) :: (Eq a, Show a) => a -> a -> Property+x ==== y+ | x /= x && y /= y = discard+ | otherwise = x === y