hedgehog-classes 0.2.5.2 → 0.2.5.3

raw patch · 4 files changed

+62/−6 lines, 4 filesdep ~aesondep ~basedep ~hedgehogPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, base, hedgehog, semirings, vector

API changes (from Hackage documentation)

Files

CHANGELOG.md +11/−0
hedgehog-classes.cabal +5/−4
src/Hedgehog/Classes/Storable.hs +3/−2
test/Spec/Storable.hs +43/−0

CHANGELOG.md view

@@ -3,6 +3,17 @@ `hedgehog-classes` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +0.2.5.3+=======+* Correct bug in which `storablePeekByte` uses the wrong offset values+* Update base upper bound. [4.12, 4.15) -> [4.12, 4.17)+* Update semirings upper bound. [0.2, 0.7) -> [0.2, 0.8)+* Update aeson upper bound. [0.9, 1.6) -> [0.9, 2.1)++0.2.5.2+=======+* Update semirings upper bound. [0.2, 0.6) -> [0.2, 0.7)+ 0.2.5.1 ======= * Bump upper bound on pretty-show from <1.10 to <1.11

hedgehog-classes.cabal view

@@ -2,7 +2,7 @@ name:   hedgehog-classes version:-  0.2.5.2+  0.2.5.3 synopsis:   Hedgehog will eat your typeclass bugs description:@@ -40,6 +40,7 @@     GHC == 8.6.5   , GHC == 8.8.3   , GHC == 8.10.1+  , GHC == 9.0.1  source-repository head   type:@@ -147,7 +148,7 @@     Hedgehog.Classes.Storable     Hedgehog.Classes.Traversable   build-depends:-    , base >= 4.12 && < 4.15+    , base >= 4.12 && < 4.17     , binary >= 0.8 && < 0.9     , containers >= 0.5 && < 0.7     , hedgehog >= 1 && < 1.1@@ -160,13 +161,13 @@   default-language:     Haskell2010   if flag(aeson)-    build-depends: aeson >= 0.9 && < 1.6+    build-depends: aeson >= 0.9 && < 2.1     cpp-options: -DHAVE_AESON --  if flag(semigroupoids) --    build-depends: semigroupoids >= 0.5.3.0 && < 0.6.0.0 --    cpp-options: -DHAVE_SEMIGROUPOIDS   if flag(semirings)-    build-depends: semirings >= 0.2 && < 0.7+    build-depends: semirings >= 0.2 && < 0.8     cpp-options: -DHAVE_SEMIRINGS   if flag(comonad)     build-depends: comonad >= 5.0 && < 5.1

src/Hedgehog/Classes/Storable.hs view

@@ -12,7 +12,7 @@  import Foreign.Marshal.Alloc import Foreign.Marshal.Array-import GHC.Ptr (Ptr(..), plusPtr)+import GHC.Ptr (Ptr(..), nullPtr, plusPtr, minusPtr, alignPtr) import Foreign.Storable (Storable(..)) import System.IO.Unsafe (unsafePerformIO) @@ -77,7 +77,8 @@ storablePeekByte gen = property $ do   as <- forAll $ genSmallNonEmptyList gen   let len = List.length as-  off <- forAll $ Gen.int (Range.linear 0 (len - 1))+  ix <- forAll $ Gen.int (Range.linear 0 (len - 1))+  let off = ix * (nullPtr `plusPtr` sizeOf (head as)) `alignPtr` alignment (head as) `minusPtr` nullPtr   unsafePerformIO $ do     addr <- genArray gen len     x :: a <- peekByteOff addr off

test/Spec/Storable.hs view

@@ -1,5 +1,11 @@ module Spec.Storable (testStorable) where +import Foreign.C.String (CString, newCString, peekCString)+import Foreign.C.Types (CInt)+import Foreign.Ptr (nullPtr, castPtr, plusPtr, minusPtr, alignPtr)+import Foreign.Storable (Storable, sizeOf, alignment, peek, peekByteOff, poke, pokeByteOff)++import Hedgehog (Gen) import Hedgehog.Classes  import qualified Hedgehog.Gen as Gen@@ -17,6 +23,7 @@   , ("Word16", lawsWord16)   , ("Word32", lawsWord32)   , ("Word64", lawsWord64)+  , ("complex struct", lawsStruct)   ]  ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b@@ -35,3 +42,39 @@ lawsWord16 = [storableLaws (ranged Gen.word16)] lawsWord32 = [storableLaws (ranged Gen.word32)] lawsWord64 = [storableLaws (ranged Gen.word64)]++lawsStruct :: [Laws]+lawsStruct = [storableLaws genStruct]++genStruct :: Gen TestStruct+genStruct = TestStruct+    <$> fmap fromIntegral (Gen.integral Range.linearBounded :: Gen CInt)+    <*> Gen.string (Range.linear 0 16) (Gen.filter (/= '\NUL') Gen.latin1)++data TestStruct = TestStruct+    { testPadding :: Int+    , testString :: String+    }+  deriving (Eq, Show)+instance Storable TestStruct where+    sizeOf _ = offsetTest + (sizeOf (undefined :: Int) `max` sizeOf (undefined :: CString))+    alignment _ = alignment (undefined :: Int) `lcm` alignment (undefined :: CString)+    peek ptr = do+        pad <- peek $ castPtr ptr+        strPtr <- peekByteOff ptr offsetTest+        str <- if strPtr == nullPtr+            then return ""+            else peekCString strPtr+        return $ TestStruct+            { testPadding = pad+            , testString = str+            }+    poke ptr x = do+        poke (castPtr ptr) $ testPadding x+        strPtr <- newCString $ testString x+        pokeByteOff ptr offsetTest strPtr++offsetTest :: Int+offsetTest = (nullPtr `plusPtr` sizeOf int) `alignPtr` alignment string `minusPtr` nullPtr+  where int = undefined :: Int+        string = undefined :: CString