quickcheck-classes 0.4.11.1 → 0.4.12

raw patch · 17 files changed

+266/−58 lines, 17 filesdep ~primitive

Dependency ranges changed: primitive

Files

• changelog.md +17/−0
• quickcheck-classes.cabal +2/−1
• src/Test/QuickCheck/Classes/Alt.hs +2/−2
• src/Test/QuickCheck/Classes/Bifunctor.hs +1/−1
• src/Test/QuickCheck/Classes/Bits.hs +4/−4
• src/Test/QuickCheck/Classes/Compat.hs +15/−0
• src/Test/QuickCheck/Classes/Foldable.hs +4/−4
• src/Test/QuickCheck/Classes/Functor.hs +2/−2
• src/Test/QuickCheck/Classes/MonadPlus.hs +2/−1
• src/Test/QuickCheck/Classes/MonadZip.hs +2/−2
• src/Test/QuickCheck/Classes/Monoid.hs +13/−3
• src/Test/QuickCheck/Classes/Ord.hs +1/−1
• src/Test/QuickCheck/Classes/Prim.hs +105/−19
• src/Test/QuickCheck/Classes/Semigroup.hs +22/−7
• src/Test/QuickCheck/Classes/ShowRead.hs +11/−0
• src/Test/QuickCheck/Classes/Storable.hs +53/−1
• src/Test/QuickCheck/Classes/Traversable.hs +10/−10

@@ -4,6 +4,23 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.4.12] - 2018-06-07+### Added+- Remaining laws for `Storable` typeclass.+- Laws for `Prim` typeclass requiring `setByteArray` and `setOffAddr` to+  match the behavior that would result from manually iterating over the+  array and writing the value element-by-element.+### Change+- Correct the law from the `Bits` typeclass that relates `clearBit`+  and `zeroBits`.+- Limit the size of the lists that are used when testing that+  `mconcat` and `sconcat` have behaviors that match their default+  implementations. For some data structures, concatenating the+  elements in a list of several dozen arbitrary values does not+  finish in a reasonable amount of time. So, the size of these+  has been limited to 6.+- Make library build against `primitive-0.6.1.0`.+ ## [0.4.11.1] - 2018-05-25 ### Change - Fix compatibility with older GHCs when `semigroupoids` support

@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.4.11.1+version: 0.4.12 synopsis: QuickCheck common typeclasses description:   This library provides QuickCheck properties to ensure@@ -56,6 +56,7 @@     Test.QuickCheck.Classes.Bifunctor     Test.QuickCheck.Classes.Bits     Test.QuickCheck.Classes.Common+    Test.QuickCheck.Classes.Compat     Test.QuickCheck.Classes.Eq     Test.QuickCheck.Classes.Foldable     Test.QuickCheck.Classes.Functor

@@ -37,9 +37,9 @@ -- | Tests the following alt properties: -- -- [/Associativity/]---   @(a '<!>' b) '<!>' c ≡ a '<!>' (b '<!>' c)@+--   @(a 'Alt.<!>' b) 'Alt.<!>' c ≡ a 'Alt.<!>' (b 'Alt.<!>' c)@ -- [/Left Distributivity/]---   @f '<$>' (a '<!>' b) = (f '<$>' a) '<!>' (f '<$>' b)+--   @f '<$>' (a 'Alt.<!>' b) ≡ (f '<$>' a) 'Alt.<!>' (f '<$>' b)@ #if defined(VERSION_semigroupoids) altLaws :: (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws altLaws p = Laws "Alt"

@@ -32,7 +32,7 @@ -- [/Second Identity/]  --   @'second' 'id' ≡ 'id'@ -- [/Bifunctor Composition/]---   @'bimap' f g ≡ 'first' f . 'second' g@ +--   @'bimap' f g ≡ 'first' f '.' 'second' g@  -- -- /Note/: This property test is only available when this package is built with -- @base-4.9+@ or @transformers-0.5+@.

@@ -130,12 +130,12 @@   "xor n (bit i)"   (\(n,BitIndex i) -> xor n (bit i)) -bitsClearZero :: forall a. (Bits a, Arbitrary a, Show a) => Proxy a -> Property+bitsClearZero :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property bitsClearZero _ = myForAllShrink False (const True)-  (\(n :: a) -> ["n = " ++ show n])+  (\(BitIndex n :: BitIndex a) -> ["n = " ++ show n])   "clearBit zeroBits n"-  (\n -> clearBit n zeroBits)-  "n"+  (\(BitIndex n) -> clearBit zeroBits n :: a)+  "zeroBits"   (\_ -> zeroBits)  bitsSetZero :: forall a. (FiniteBits a, Arbitrary a, Show a) => Proxy a -> Property

@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module Test.QuickCheck.Classes.Compat+  ( isTrue#+  ) where++#if MIN_VERSION_base(4,7,0)+import GHC.Exts (isTrue#)+#endif++#if !MIN_VERSION_base(4,7,0)+isTrue# :: Bool -> Bool+isTrue# b = b+#endif

@@ -11,7 +11,7 @@   ) where  import Data.Monoid-import Data.Foldable (foldMap,Foldable)+import Data.Foldable import Test.QuickCheck hiding ((.&.)) #if MIN_VERSION_QuickCheck(2,10,0) import Control.Exception (ErrorCall,try,evaluate)@@ -42,9 +42,9 @@ -- [/foldr/] --   @'foldr' f z t ≡ 'appEndo' ('foldMap' ('Endo' . f) t ) z@ -- [/foldr'/]---   @'foldr'' f z0 xs = let f\' k x z = k '$!' f x z in 'foldl' f\' 'id' xs z0@+--   @'foldr'' f z0 xs ≡ let f\' k x z = k '$!' f x z in 'foldl' f\' 'id' xs z0@ -- [/foldr1/]---   @'foldr1' f t ≡ let Just (xs,x) = unsnoc ('toList' t) in 'foldr' f x xs@+--   @'foldr1' f t ≡ let 'Just' (xs,x) = 'unsnoc' ('toList' t) in 'foldr' f x xs@ -- [/foldl/] --   @'foldl' f z t ≡ 'appEndo' ('getDual' ('foldMap' ('Dual' . 'Endo' . 'flip' f) t)) z@ -- [/foldl'/]@@ -56,7 +56,7 @@ -- [/null/] --   @'null' ≡ 'foldr' ('const' ('const' 'False')) 'True'@ -- [/length/]---   @'length' ≡ getSum . foldMap ('const' ('Sum' 1))@+--   @'length' ≡ 'getSum' . 'foldMap' ('const' ('Sum' 1))@ -- -- Note that this checks to ensure that @foldl\'@ and @foldr\'@ -- are suitably strict.

@@ -31,9 +31,9 @@ -- [/Identity/] --   @'fmap' 'id' ≡ 'id'@ -- [/Composition/]---   @fmap (f . g) ≡ 'fmap' f . 'fmap' g@+--   @'fmap' (f '.' g) ≡ 'fmap' f '.' 'fmap' g@ -- [/Const/]---   @(<$) ≡ 'fmap' 'const'@+--   @('<$') ≡ 'fmap' 'const'@ functorLaws :: (Functor f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws functorLaws p = Laws "Functor"   [ ("Identity", functorIdentity p)

@@ -12,6 +12,7 @@  import Test.QuickCheck hiding ((.&.)) #if MIN_VERSION_QuickCheck(2,10,0)+import Control.Applicative(Alternative(empty)) import Control.Monad (MonadPlus(mzero,mplus)) import Test.QuickCheck.Arbitrary (Arbitrary1(..)) #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)@@ -37,7 +38,7 @@ -- [/Left Zero/] --   @'mzero' '>>=' f ≡ 'mzero'@ -- [/Right Zero/]---   @m >> 'mzero' ≡ 'mzero'@+--   @m '>>' 'mzero' ≡ 'mzero'@ monadPlusLaws :: (MonadPlus f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws monadPlusLaws p = Laws "MonadPlus"   [ ("Left Identity", monadPlusLeftIdentity p)

@@ -32,9 +32,9 @@ -- | Tests the following monadic zipping properties: -- -- [/Naturality/]---   @liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)@+--   @'liftM' (f '***' g) ('mzip' ma mb) = 'mzip' ('liftM' f ma) ('liftM' g mb)@ ----- In the laws above, the infix function @***@ refers to a typeclass+-- In the laws above, the infix function @'***'@ refers to a typeclass -- method of 'Arrow'. monadZipLaws :: (MonadZip f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws monadZipLaws p = Laws "MonadZip"

@@ -43,11 +43,11 @@  monoidConcatenation :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property monoidConcatenation _ = myForAllShrink True (const True)-  (\(as :: [a]) -> ["as = " ++ show as])+  (\(SmallList (as :: [a])) -> ["as = " ++ show as])   "mconcat as"-  (\as -> mconcat as)+  (\(SmallList as) -> mconcat as)   "foldr mappend mempty as"-  (\as -> foldr mappend mempty as)+  (\(SmallList as) -> foldr mappend mempty as)  monoidAssociative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property monoidAssociative _ = myForAllShrink True (const True)@@ -80,4 +80,14 @@   (\(a,b) -> mappend a b)   "mappend b a"   (\(a,b) -> mappend b a)++newtype SmallList a = SmallList { getSmallList :: [a] }+  deriving (Eq,Show)++instance Arbitrary a => Arbitrary (SmallList a) where+  arbitrary = do+    n <- choose (0,6)+    xs <- vector n+    return (SmallList xs)+  shrink = map SmallList . shrink . getSmallList 

@@ -15,7 +15,7 @@ -- | Tests the following properties: -- -- [/Antisymmetry/]---   @a ≤ b ∧ b ≤ a ⇒ a = b  +--   @a ≤ b ∧ b ≤ a ⇒ a = b@  -- [/Transitivity/] --   @a ≤ b ∧ b ≤ c ⇒ a ≤ c@ -- [/Totality/]

@@ -20,8 +20,8 @@ import Data.Primitive.Addr import Foreign.Marshal.Alloc import GHC.Exts-  (Int(I#),(*#),newByteArray#,unsafeFreezeByteArray#,copyMutableByteArray#-  ,copyByteArray#,quotInt#,sizeofByteArray#)+  (State#,Int#,Addr#,Int(I#),(*#),(+#),(<#),newByteArray#,unsafeFreezeByteArray#,+   copyMutableByteArray#,copyByteArray#,quotInt#,sizeofByteArray#)  #if MIN_VERSION_base(4,7,0) import GHC.Exts (IsList(fromList,toList,fromListN),Item,@@ -37,18 +37,21 @@ import qualified Data.Primitive as P  import Test.QuickCheck.Classes.Common (Laws(..))+import Test.QuickCheck.Classes.Compat (isTrue#)  -- | Test that a 'Prim' instance obey the several laws. primLaws :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws primLaws p = Laws "Prim"-  [ ("ByteArray Set-Get (you get back what you put in)", primSetGetByteArray p)-  , ("ByteArray Get-Set (putting back what you got out has no effect)", primGetSetByteArray p)-  , ("ByteArray Set-Set (setting twice is same as setting once)", primSetSetByteArray p)+  [ ("ByteArray Put-Get (you get back what you put in)", primPutGetByteArray p)+  , ("ByteArray Get-Put (putting back what you got out has no effect)", primGetPutByteArray p)+  , ("ByteArray Put-Put (putting twice is same as putting once)", primPutPutByteArray p)+  , ("ByteArray Set Range", primSetByteArray p) #if MIN_VERSION_base(4,7,0)   , ("ByteArray List Conversion Roundtrips", primListByteArray p) #endif-  , ("Addr Set-Get (you get back what you put in)", primSetGetAddr p)-  , ("Addr Get-Set (putting back what you got out has no effect)", primGetSetAddr p)+  , ("Addr Put-Get (you get back what you put in)", primPutGetAddr p)+  , ("Addr Get-Put (putting back what you got out has no effect)", primGetPutAddr p)+  , ("Addr Set Range", primSetOffAddr p)   , ("Addr List Conversion Roundtrips", primListAddr p)   ] @@ -72,8 +75,8 @@   free ptr   return (as == asNew) -primSetGetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-primSetGetByteArray _ = property $ \(a :: a) len -> (len > 0) ==> do+primPutGetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primPutGetByteArray _ = property $ \(a :: a) len -> (len > 0) ==> do   ix <- choose (0,len - 1)   return $ runST $ do     arr <- newPrimArray len@@ -81,8 +84,8 @@     a' <- readPrimArray arr ix     return (a == a') -primGetSetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-primGetSetByteArray _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do+primGetPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primGetPutByteArray _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do   let arr1 = primArrayFromList as :: PrimArray a       len = L.length as   ix <- choose (0,len - 1)@@ -94,8 +97,8 @@     unsafeFreezePrimArray marr   return (arr1 == arr2) -primSetSetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-primSetSetByteArray _ = property $ \(a :: a) (as :: [a]) -> (not (L.null as)) ==> do+primPutPutByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primPutPutByteArray _ = property $ \(a :: a) (as :: [a]) -> (not (L.null as)) ==> do   let arr1 = primArrayFromList as :: PrimArray a       len = L.length as   ix <- choose (0,len - 1)@@ -111,8 +114,8 @@     return (arr2,arr3)   return (arr2 == arr3) -primSetGetAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-primSetGetAddr _ = property $ \(a :: a) len -> (len > 0) ==> do+primPutGetAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primPutGetAddr _ = property $ \(a :: a) len -> (len > 0) ==> do   ix <- choose (0,len - 1)   return $ unsafePerformIO $ do     ptr@(Ptr addr#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))@@ -122,8 +125,8 @@     free ptr     return (a == a') -primGetSetAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-primGetSetAddr _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do+primGetPutAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primGetPutAddr _ = property $ \(as :: [a]) -> (not (L.null as)) ==> do   let arr1 = primArrayFromList as :: PrimArray a       len = L.length as   ix <- choose (0,len - 1)@@ -139,7 +142,52 @@     unsafeFreezePrimArray marr   return (arr1 == arr2) +primSetByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primSetByteArray _ = property $ \(as :: [a]) (z :: a) -> do+  let arr1 = primArrayFromList as :: PrimArray a+      len = L.length as+  x <- choose (0,len)+  y <- choose (0,len)+  let lo = min x y+      hi = max x y+  return $ runST $ do+    marr2 <- newPrimArray len+    copyPrimArray marr2 0 arr1 0 len+    marr3 <- newPrimArray len+    copyPrimArray marr3 0 arr1 0 len+    setPrimArray marr2 lo (hi - lo) z+    internalDefaultSetPrimArray marr3 lo (hi - lo) z+    arr2 <- unsafeFreezePrimArray marr2+    arr3 <- unsafeFreezePrimArray marr3+    return (arr2 == arr3) +primSetOffAddr :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property+primSetOffAddr _ = property $ \(as :: [a]) (z :: a) -> do+  let arr1 = primArrayFromList as :: PrimArray a+      len = L.length as+  x <- choose (0,len)+  y <- choose (0,len)+  let lo = min x y+      hi = max x y+  return $ unsafePerformIO $ do+    ptrA@(Ptr addrA#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))+    let addrA = Addr addrA#+    copyPrimArrayToPtr ptrA arr1 0 len+    ptrB@(Ptr addrB#) :: Ptr a <- mallocBytes (len * P.sizeOf (undefined :: a))+    let addrB = Addr addrB#+    copyPrimArrayToPtr ptrB arr1 0 len+    setOffAddr addrA lo (hi - lo) z+    internalDefaultSetOffAddr addrB lo (hi - lo) z+    marrA <- newPrimArray len+    copyPtrToMutablePrimArray marrA 0 ptrA len+    free ptrA+    marrB <- newPrimArray len+    copyPtrToMutablePrimArray marrB 0 ptrB len+    free ptrB+    arrA <- unsafeFreezePrimArray marrA+    arrB <- unsafeFreezePrimArray marrB+    return (arrA == arrB)+ -- byte array with phantom variable that specifies element type data PrimArray a = PrimArray ByteArray# data MutablePrimArray s a = MutablePrimArray (MutableByteArray# s)@@ -162,7 +210,7 @@ indexPrimArray (PrimArray arr#) (I# i#) = indexByteArray# arr# i#  sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int-sizeofPrimArray (PrimArray arr#) = I# (quotInt# (sizeofByteArray# arr#) (sizeOf# (undefined :: a)))+sizeofPrimArray (PrimArray arr#) = I# (quotInt# (sizeofByteArray# arr#) (P.sizeOf# (undefined :: a)))  newPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) newPrimArray (I# n#)@@ -271,6 +319,16 @@       (n# *# (sizeOf# (undefined :: a)))     ) +setPrimArray+  :: (Prim a, PrimMonad m)+  => MutablePrimArray (PrimState m) a -- ^ array to fill+  -> Int -- ^ offset into array+  -> Int -- ^ number of values to fill+  -> a -- ^ value to fill with+  -> m ()+setPrimArray (MutablePrimArray dst#) (I# doff#) (I# sz#) x+  = primitive_ (P.setByteArray# dst# doff# sz# x)+ primArrayFromList :: Prim a => [a] -> PrimArray a primArrayFromList xs = primArrayFromListN (L.length xs) xs @@ -296,9 +354,37 @@     then indexPrimArray arr ix : go (ix + 1)     else [] - #if MIN_VERSION_base(4,7,0) primListByteArray :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> Property primListByteArray _ = property $ \(as :: [a]) ->   as == toList (fromList as :: PrimArray a) #endif++setOffAddr :: forall a. Prim a => Addr -> Int -> Int -> a -> IO ()+setOffAddr addr ix len a = setAddr (plusAddr addr (P.sizeOf (undefined :: a) * ix)) len a++internalDefaultSetPrimArray :: Prim a+  => MutablePrimArray s a -> Int -> Int -> a -> ST s ()+internalDefaultSetPrimArray (MutablePrimArray arr) (I# i) (I# len) ident =+  primitive_ (internalDefaultSetByteArray# arr i len ident)++internalDefaultSetByteArray# :: Prim a+  => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+internalDefaultSetByteArray# arr# i# len# ident = go 0#+  where+  go ix# s0 = if isTrue# (ix# <# len#)+    then case writeByteArray# arr# (i# +# ix#) ident s0 of+      s1 -> go (ix# +# 1#) s1+    else s0++internalDefaultSetOffAddr :: Prim a => Addr -> Int -> Int -> a -> IO ()+internalDefaultSetOffAddr (Addr addr) (I# ix) (I# len) a = primitive_+  (internalDefaultSetOffAddr# addr ix len a)++internalDefaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s+internalDefaultSetOffAddr# addr# i# len# ident = go 0#+  where+  go ix# s0 = if isTrue# (ix# <# len#)+    then case writeOffAddr# addr# (i# +# ix#) ident s0 of+      s1 -> go (ix# +# 1#) s1+    else s0

@@ -20,11 +20,11 @@ -- | Tests the following properties: -- -- [/Associative/]---   @a <> (b <> c) ≡ (a <> b) <> c@+--   @a '<>' (b '<>' c) ≡ (a '<>' b) '<>' c@ -- [/Concatenation/]---   @sconcat as ≡ foldr1 (<>) as@+--   @'sconcat' as ≡ 'foldr1' ('<>') as@ -- [/Times/]---   @stimes n a ≡ foldr1 (<>) (replicate n a)@+--   @'stimes' n a ≡ 'foldr1' ('<>') (replicate n a)@ semigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws semigroupLaws p = Laws "Semigroup"   [ ("Associative", semigroupAssociative p)@@ -33,15 +33,20 @@   ]  semigroupAssociative :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property-semigroupAssociative _ = property $ \(a :: a) b c -> a <> (b <> c) == (a <> b) <> c+semigroupAssociative _ = myForAllShrink True (const True)+  (\(a :: a,b,c) -> ["a = " ++ show a, "b = " ++ show b, "c = " ++ show c])+  "a <> (b <> c)"+  (\(a,b,c) -> a <> (b <> c))+  "(a <> b) <> c"+  (\(a,b,c) -> (a <> b) <> c)  semigroupConcatenation :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property semigroupConcatenation _ = myForAllShrink True (const True)-  (\(a, as :: [a]) -> ["as = " ++ show (a :| as)])+  (\(a, SmallList (as :: [a])) -> ["as = " ++ show (a :| as)])   "sconcat as"-  (\(a,as) -> sconcat (a :| as))+  (\(a, SmallList as) -> sconcat (a :| as))   "foldr1 (<>) as"-  (\(a,as) -> foldr1 (<>) (a :| as))+  (\(a, SmallList as) -> foldr1 (<>) (a :| as))  semigroupTimes :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property semigroupTimes _ = myForAllShrink True (\(_,n) -> n > 0)@@ -50,4 +55,14 @@   (\(a,n) -> stimes n a)   "foldr1 (<>) (replicate n a)"   (\(a,n) -> foldr1 (<>) (replicate n a))++newtype SmallList a = SmallList { getSmallList :: [a] }+  deriving (Eq,Show)++instance Arbitrary a => Arbitrary (SmallList a) where+  arbitrary = do+    n <- choose (0,6)+    xs <- vector n+    return (SmallList xs)+  shrink = map SmallList . shrink . getSmallList 

@@ -17,6 +17,17 @@  import Test.QuickCheck.Classes.Common (Laws(..)) +-- | Tests the following properties:+--+-- [/Partial Isomorphism/]+--   @'readMaybe' ('show' a) == 'Just' a@+--  +-- /Note:/ When using @base-4.5@ or older, this+-- instead test the following:+--+-- [/Partial Isomorphism/]+--   @'read' ('show' a) == a@ +-- showReadLaws :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> Laws showReadLaws p = Laws "Show/Read"   [ ("Partial Isomorphism", showReadPartialIsomorphism p)

@@ -17,7 +17,7 @@ import Foreign.Marshal.Array import Foreign.Storable -import GHC.Ptr (Ptr(..))+import GHC.Ptr (Ptr(..), plusPtr) import System.IO.Unsafe import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Property (Property)@@ -31,7 +31,59 @@   [ ("Set-Get (you get back what you put in)", storableSetGet p)   , ("Get-Set (putting back what you got out has no effect)", storableGetSet p)   , ("List Conversion Roundtrips", storableList p)+  , ("peekElemOff a i ≡ peek (plusPtr a (i * sizeOf undefined))", storablePeekElem p)+  , ("peekElemOff a i x ≡ poke (plusPtr a (i * sizeOf undefined)) x ≡ id ", storablePokeElem p)+  , ("peekByteOff a i ≡ peek (plusPtr a i)", storablePeekByte p)+  , ("peekByteOff a i x ≡ poke (plusPtr a i) x ≡ id ", storablePokeByte p)   ]++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 <- mallocArray len+    x <- peekElemOff addr ix+    y <- peek (addr `plusPtr` (ix * sizeOf (undefined :: a)))+    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 <- mallocArray 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)++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 <- mallocArray 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 <- mallocArray 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

@@ -33,23 +33,23 @@ -- | Tests the following 'Traversable' properties: -- -- [/Naturality/]---   @t . 'traverse' f = 'traverse' (t . f)@+--   @t '.' 'traverse' f ≡ 'traverse' (t '.' f)@ --   for every applicative transformation @t@ -- [/Identity/]---   @'traverse' Identity = Identity@+--   @'traverse' 'Identity' ≡ 'Identity'@ -- [/Composition/]---   @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@+--   @'traverse' ('Compose' '.' 'fmap' g '.' f) ≡ 'Compose' '.' 'fmap' ('traverse' g) '.' 'traverse' f@ -- [/Sequence Naturality/]---   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@+--   @t '.' 'sequenceA' ≡ 'sequenceA' '.' 'fmap' t@ --   for every applicative transformation @t@ -- [/Sequence Identity/]---   @'sequenceA' . 'fmap' Identity = Identity@+--   @'sequenceA' '.' 'fmap' 'Identity' ≡ 'Identity'@ -- [/Sequence Composition/]---   @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@+--   @'sequenceA' '.' 'fmap' 'Compose' ≡ 'Compose' '.' 'fmap' 'sequenceA' '.' 'sequenceA'@ -- [/foldMap/]---   @'foldMap' = 'foldMapDefault'@+--   @'foldMap' ≡ 'foldMapDefault'@ -- [/fmap/]---   @'fmap' = 'fmapDefault'@+--   @'fmap' ≡ 'fmapDefault'@ -- -- Where an /applicative transformation/ is a function --@@ -57,8 +57,8 @@ -- -- preserving the 'Applicative' operations, i.e. ----- * Identity: @t ('pure' x) = 'pure' x@--- * Distributivity: @t (x '<*>' y) = t x '<*>' t y@+-- * Identity: @t ('pure' x) ≡ 'pure' x@+-- * Distributivity: @t (x '<*>' y) ≡ t x '<*>' t y@ traversableLaws :: (Traversable f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws traversableLaws = traversableLawsInternal