derive-storable 0.1.1.1 → 0.1.2.0

raw patch · 9 files changed

+421/−64 lines, 9 filesdep +criteriondep +deepseqdep +derive-storabledep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: criterion, deepseq, derive-storable

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• benchmark/Main.hs +123/−0
• benchmark/TestCases.hs +103/−0
• derive-storable.cabal +17/−6
• src/Foreign/Storable/Generic/Internal.hs +13/−0
• test/Basic/MemoryCSpec.hs +4/−0
• test/Basic/TestCases.hs +51/−20
• test/Basic/cbits/TestCases.c +89/−37
• test/Spec/Spec.hs +13/−1

@@ -1,5 +1,13 @@ # Revision history for derive-storable +## 0.1.2.0  -- 2018-04-30++* Added U1 instance for GHC.Generics.++## 0.1.1.1 rev1 -- 2018-03-20++* Bump to GHC 8.4.1+ ## 0.1.1.1  -- 2017-10-05  * Fixed a bug with POSIX types enabled on non POSIX systems.

@@ -0,0 +1,123 @@+{-#LANGUAGE AllowAmbiguousTypes #-}+{-#LANGUAGE ScopedTypeVariables #-}++import Criterion.Main+import Criterion.Types+import TestCases+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array (mallocArray, peekArray, pokeArray)+import Foreign.Ptr+import Foreign.Storable+import Foreign.Storable.Generic+import Foreign.Storable.Generic.Internal++import GHC.Generics (from, to)++import GHC.Exts++import Control.DeepSeq+import Data.Proxy+++mallocFree :: forall a. (Storable a) => a -> IO ()+mallocFree a = do+    ptr <- mallocBytes $ (sizeOf a)+    free ptr++singularTests = +--   [ bgroup "mallocfree" $ +--      [ bgroup "Handwritten" $+--          [ bench "C1" $ nfIO (mallocFree c1hw_def)+--          , bench "C2" $ nfIO (mallocFree c2hw_def)+--          , bench "C3" $ nfIO (mallocFree c3hw_def)+--          , bench "C4" $ nfIO (mallocFree c4hw_def)+--          , bench "C5" $ nfIO (mallocFree c5hw_def)+--          ]+--      , bgroup "GStorable" $+--          [ bench "C1" $ nfIO (mallocFree c1_def)+--          , bench "C2" $ nfIO (mallocFree c2_def)+--          , bench "C3" $ nfIO (mallocFree c3_def)+--          , bench "C4" $ nfIO (mallocFree c4_def)+--          , bench "C5" $ nfIO (mallocFree c5_def)+--          ]+--      ]+   [ bgroup "sizeOf" $ +       [ bgroup "Handwritten" $+           [ bench "C0" $ nf sizeOf c0hw_def+           , bench "C1" $ nf sizeOf c1hw_def+           , bench "C2" $ nf sizeOf c2hw_def+           , bench "C3" $ nf sizeOf c3hw_def+           , bench "C4" $ nf sizeOf c4hw_def+           , bench "C5" $ nf sizeOf c5hw_def+           ]+       +       , bgroup "GStorable" $+           [ bench "C0" $ nf sizeOf c0_def+           , bench "C1" $ nf sizeOf c1_def+           , bench "C2" $ nf sizeOf c2_def+           , bench "C3" $ nf sizeOf c3_def+           , bench "C4" $ nf sizeOf c4_def+           , bench "C5" $ nf sizeOf c5_def+           ]+       ]+   , bgroup "alignment" $ +       [ bgroup "Handwritten" $+           [ bench "C0" $ nf alignment c0hw_def+           , bench "C1" $ nf alignment c1hw_def+           , bench "C2" $ nf alignment c2hw_def+           , bench "C3" $ nf alignment c3hw_def+           , bench "C4" $ nf alignment c4hw_def+           , bench "C5" $ nf alignment c5hw_def+           ]+       , bgroup "GStorable" $+           [ bench "C0" $ nf alignment c0_def+           , bench "C1" $ nf alignment c1_def+           , bench "C2" $ nf alignment c2_def+           , bench "C3" $ nf alignment c3_def+           , bench "C4" $ nf alignment c4_def+           , bench "C5" $ nf alignment c5_def+           ]+       ]+   , bgroup "peek" $+       [ bgroup "Handwritten" $+           [ env (malloc :: IO (Ptr C0hw)) $ \ptr -> bench "C0" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C1hw)) $ \ptr -> bench "C1" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C2hw)) $ \ptr -> bench "C2" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C3hw)) $ \ptr -> bench "C3" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C4hw)) $ \ptr -> bench "C4" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C5hw)) $ \ptr -> bench "C5" $ nfIO (peek ptr)+           ]+       , bgroup "GStorable" $+           [ env (malloc :: IO (Ptr C0)) $ \ptr -> bench "C0" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C1)) $ \ptr -> bench "C1" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C2)) $ \ptr -> bench "C2" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C3)) $ \ptr -> bench "C3" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C4)) $ \ptr -> bench "C4" $ nfIO (peek ptr)+           , env (malloc :: IO (Ptr C5)) $ \ptr -> bench "C5" $ nfIO (peek ptr)+           ]+       ] +  , bgroup "poke" $+      [ bgroup "Handwritten" $     +          [ env malloc $ \ptr -> bench "C0" $ nfIO (poke ptr c0hw_def) +          , env malloc $ \ptr -> bench "C1" $ nfIO (poke ptr c1hw_def) +          , env malloc $ \ptr -> bench "C2" $ nfIO (poke ptr c2hw_def)+          , env malloc $ \ptr -> bench "C3" $ nfIO (poke ptr c3hw_def)+          , env malloc $ \ptr -> bench "C4" $ nfIO (poke ptr c4hw_def)+          , env malloc $ \ptr -> bench "C5" $ nfIO (poke ptr c5hw_def)+          ]+      , bgroup "GStorable" $+          [ env malloc $ \ptr -> bench "C0" $ nfIO (poke ptr c0_def) +          , env malloc $ \ptr -> bench "C1" $ nfIO (poke ptr c1_def) +          , env malloc $ \ptr -> bench "C2" $ nfIO (poke ptr c2_def)+          , env malloc $ \ptr -> bench "C3" $ nfIO (poke ptr c3_def)+          , env malloc $ \ptr -> bench "C4" $ nfIO (poke ptr c4_def)+          , env malloc $ \ptr -> bench "C5" $ nfIO (poke ptr c5_def)+          ]+      ]+  ]++++-- Our benchmark harness.+main = defaultMain $ singularTests+

@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+module TestCases where ++import GHC.Generics (Generic)+import Foreign.Storable.Generic+import Data.Int+import Control.DeepSeq+++data C0 = C0                      deriving (Show, Generic, GStorable, NFData)+data C1 = C1 Int32                deriving (Show, Generic, GStorable, NFData)+data C2 = C2 Int8 C0 Int32 Int16  deriving (Show, Generic, GStorable, NFData)+data C3 = C3 C2 Int64 C1          deriving (Show, Generic, GStorable, NFData)+data C4 = C4 Double Int8 C3       deriving (Show, Generic, GStorable, NFData)+data C5 = C5 Int32 C2 C4 C0       deriving (Show, Generic, GStorable, NFData)++c0_def = C0+c1_def = C1 3+c2_def = C2 3 c0_def 10 8+c3_def = C3 c2_def 11000 c1_def+c4_def = C4 0.312 3 c3_def +c5_def = C5 100 c2_def c4_def c0_def+++data C0hw = C0hw                       deriving (Show, Generic, NFData)+data C1hw = C1hw Int32                 deriving (Show, Generic, NFData)+data C2hw = C2hw Int8 C0hw Int32 Int16 deriving (Show, Generic, NFData)+data C3hw = C3hw C2hw Int64 C1hw       deriving (Show, Generic, NFData)+data C4hw = C4hw Double Int8 C3hw      deriving (Show, Generic, NFData)+data C5hw = C5hw Int32 C2hw C4hw C0hw  deriving (Show, Generic, NFData)++c0hw_def = C0hw+c1hw_def = C1hw 3+c2hw_def = C2hw 3 c0hw_def 10 8+c3hw_def = C3hw c2hw_def 11000 c1hw_def+c4hw_def = C4hw 0.312 3 c3hw_def +c5hw_def = C5hw 100 c2hw_def c4hw_def c0hw_def++instance Storable C0hw where+    sizeOf                         _ = 0+    alignment                      _ = 1+    peekByteOff ptr off              = return C0hw+    pokeByteOff ptr off (C0hw)       = return ()++instance Storable C1hw where+    sizeOf                         _ = 4+    alignment                      _ = 4+    peekByteOff ptr off              = C1hw <$> (peekByteOff ptr off :: IO Int32) +    pokeByteOff ptr off (C1hw v) = pokeByteOff ptr off v++instance Storable C2hw where+    sizeOf                         _ = 12+    alignment                      _ = 4+    peekByteOff ptr off              = C2hw +        <$> (peekByteOff ptr off        :: IO Int8 ) +        <*> (peekByteOff ptr (off + 1)  :: IO C0hw ) +        <*> (peekByteOff ptr (off + 4)  :: IO Int32) +        <*> (peekByteOff ptr (off + 8)  :: IO Int16) +                                       +    pokeByteOff ptr off (C2hw i8a c0hw i32 i16) = do+        pokeByteOff ptr  off       i8a+        pokeByteOff ptr (off + 1)  c0hw+        pokeByteOff ptr (off + 4)  i32+        pokeByteOff ptr (off + 8)  i16++instance Storable C3hw where+    sizeOf              _ = 32+    alignment           _ = 8+    peekByteOff ptr off = C3hw +        <$> (peekByteOff ptr off        :: IO C2hw ) +        <*> (peekByteOff ptr (off + 16) :: IO Int64) +        <*> (peekByteOff ptr (off + 24) :: IO C1hw) +                                       +    pokeByteOff ptr off (C3hw c2hw i64 c1hw) = do+        pokeByteOff ptr  off        c2hw+        pokeByteOff ptr (off + 16)  i64+        pokeByteOff ptr (off + 24)  c1hw++instance Storable C4hw where+    sizeOf              _ = 48+    alignment           _ = 8+    peekByteOff ptr off   = C4hw +        <$> (peekByteOff ptr  off       :: IO Double)+        <*> (peekByteOff ptr (off + 8)  :: IO Int8  )+        <*> (peekByteOff ptr (off + 16) :: IO C3hw  )+    pokeByteOff ptr off (C4hw dbl i8 c3hw) = do+        pokeByteOff ptr  off       dbl+        pokeByteOff ptr (off + 8)  i8+        pokeByteOff ptr (off + 16) c3hw++instance Storable C5hw where +    sizeOf              _ = 72+    alignment           _ = 8+    peekByteOff ptr off   = C5hw +        <$> (peekByteOff ptr  off       :: IO Int32)+        <*> (peekByteOff ptr (off + 4 ) :: IO C2hw )+        <*> (peekByteOff ptr (off + 16) :: IO C4hw )+        <*> (peekByteOff ptr (off + 64) :: IO C0hw )+    pokeByteOff ptr off (C5hw i32 c2hw c4hw c0hw) = do+        pokeByteOff ptr  off       i32+        pokeByteOff ptr (off + 4)  c2hw+        pokeByteOff ptr (off + 16) c4hw+        pokeByteOff ptr (off + 64) c0hw

@@ -1,6 +1,6 @@ name:                derive-storable -version:             0.1.1.1+version:             0.1.2.0 synopsis:            Derive Storable instances with GHC.Generics.             description:         Derive Storable instances with GHC.Generics. The derived Storable instances have the same alignment as C structs.@@ -20,16 +20,26 @@ extra-source-files:  ChangeLog.md README.md  cabal-version:       >=1.10-tested-with:         GHC==7.10.3, GHC==8.0.1, GHC==8.0.2, GHC==8.2.1+tested-with:         GHC==8.0.1, GHC==8.0.2, GHC==8.2.1, GHC==8.4.1, GHC==8.4.2  library   exposed-modules:     Foreign.Storable.Generic, Foreign.Storable.Generic.Tools                      , Foreign.Storable.Generic.Internal, Foreign.Storable.Generic.Instances       -  build-depends:       base >=4.8 && < 4.11+  build-depends:       base >=4.8 && < 5   hs-source-dirs:      src   default-language:    Haskell2010-  +benchmark benchmark+  type:                exitcode-stdio-1.0+  hs-source-dirs:      benchmark/+  default-language:    Haskell2010+  other-modules:       TestCases+  Main-is:             Main.hs+  build-depends:       base >= 4.8 && < 5, deepseq, criterion >= 1.1.0+                    ,  derive-storable +++ test-suite c_alignment   type:                exitcode-stdio-1.0   @@ -42,7 +52,7 @@                      , Foreign.Storable.Generic.Tools                      , TestCases    -  build-depends:       base >= 4.8 && < 4.11, hspec == 2.4.*,QuickCheck >= 2.10+  build-depends:       base >= 4.8 && < 5, hspec >= 2.4, QuickCheck >= 2.10      default-language:    Haskell2010 @@ -60,7 +70,7 @@                        , Foreign.Storable.Generic.ToolsSpec                        , GenericType -  build-depends:       base >= 4.8 && < 4.11, hspec == 2.4.*, QuickCheck >= 2.10+  build-depends:       base >= 4.8 && < 5, hspec >= 2.4, QuickCheck >= 2.10    default-language:    Haskell2010 @@ -69,3 +79,4 @@   type:                git   location:            https://github.com/mkloczko/derive-storable   branch:              master+

@@ -85,6 +85,19 @@     glistSizeOf' _ = glistSizeOf' (undefined :: f p)     glistAlignment' _ = glistAlignment' (undefined :: f p) +instance GStorable' U1 where+    -- Wrap the peeked value in metadata.+    {-# INLINE gpeekByteOff' #-}+    gpeekByteOff' offsets ix ptr offset = return U1+    -- Discard the metadata and go further.+    {-# INLINE gpokeByteOff' #-}+    gpokeByteOff' offsets ix ptr offset (U1) = return ()+    ++    gnumberOf' (U1)   = 0+    glistSizeOf'    _ = []+    glistAlignment' _ = []+ instance (GStorable' f, GStorable' g) => GStorable' (f :*: g) where     -- Tree-like traversal for reading the type.     {-# INLINE gpeekByteOff' #-}

@@ -29,6 +29,7 @@     checkFields ptr1 ptr2 `shouldReturn` True main = hspec $ do     describe "Test for same size" $ do+        it "C0" $ property $ (same_size      :: C0 -> Expectation)         it "C1" $ property $ (same_size      :: C1 -> Expectation)         it "C2" $ property $ (same_size      :: C2 -> Expectation)         it "C3" $ property $ (same_size      :: C3 -> Expectation)@@ -50,6 +51,7 @@         it "C19" $ property $ (same_size      :: C19 -> Expectation)         it "C20" $ property $ (same_size      :: C20 -> Expectation)     describe "Test for same alignment" $ do+        it "C0" $ property $ (same_alignment :: C0 -> Expectation)         it "C1" $ property $ (same_alignment :: C1 -> Expectation)         it "C2" $ property $ (same_alignment :: C2 -> Expectation)         it "C3" $ property $ (same_alignment :: C3 -> Expectation)@@ -71,6 +73,7 @@         it "C19" $ property $ (same_alignment :: C19 -> Expectation)         it "C20" $ property $ (same_alignment :: C20 -> Expectation)     describe "Test for same offsets" $ do+        it "C0" $ property $ (same_offsets   :: C0 -> Expectation)         it "C1" $ property $ (same_offsets   :: C1 -> Expectation)         it "C2" $ property $ (same_offsets   :: C2 -> Expectation)         it "C3" $ property $ (same_offsets   :: C3 -> Expectation)@@ -92,6 +95,7 @@         it "C19" $ property $ (same_offsets   :: C19 -> Expectation)         it "C20" $ property $ (same_offsets   :: C20 -> Expectation)     describe "Test for same fields" $ do+        it "C0" $ property $ (same_fields    :: C0 -> Expectation)         it "C1" $ property $ (same_fields    :: C1 -> Expectation)         it "C2" $ property $ (same_fields    :: C2 -> Expectation)         it "C3" $ property $ (same_fields    :: C3 -> Expectation)

@@ -50,6 +50,27 @@ goffsets :: (GStorable' (Rep a), GStorable a, Generic a) => a -> [Int16] goffsets v = map fromIntegral $ internalOffsets (from v) +data C0 = C0 +    deriving (Show, Eq, Generic, GStorable)++instance Checkable C0 where+    checkFields    ptr1 ptr2 = (==1) <$> checkFieldsC0 ptr1 ptr2+    checkOffsets   _    offs = (==1) <$> checkOffsetsC0 offs+    getSize        a          = fromIntegral <$> getSizeC0+    getAlignment   a          = fromIntegral <$> getAlignmentC0+    new (C0 ) = do+        ptr <- newC0 +        return ptr++instance Arbitrary C0 where +    arbitrary = return C0++foreign import ccall newC0 :: IO (Ptr C0)+foreign import ccall checkFieldsC0 :: Ptr C0 -> Ptr C0 -> IO Int8+foreign import ccall checkOffsetsC0 :: Ptr Int16 -> IO Int8+foreign import ccall getSizeC0 :: IO Int16+foreign import ccall getAlignmentC0 :: IO Int16+ data C1 = C1 Int32 Int32     deriving (Show, Eq, Generic, GStorable) @@ -71,7 +92,7 @@ foreign import ccall getSizeC1 :: IO Int16 foreign import ccall getAlignmentC1 :: IO Int16 -data C2 = C2 Int32 Int16 Int8+data C2 = C2 Int32 C0 Int16 Int8     deriving (Show, Eq, Generic, GStorable)  instance Checkable C2 where@@ -79,14 +100,16 @@     checkOffsets   _    offs = (==1) <$> checkOffsetsC2 offs     getSize        a          = fromIntegral <$> getSizeC2     getAlignment   a          = fromIntegral <$> getAlignmentC2-    new (C2 a b c) = do-        ptr <- newC2 a b c+    new (C2 a b c d) = do+        ptr_b <- newStorable b+        ptr <- newC2 a ptr_b c d+        free ptr_b         return ptr  instance Arbitrary C2 where -    arbitrary = C2 <$> arbitrary <*> arbitrary <*> arbitrary+    arbitrary = C2 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -foreign import ccall newC2 :: Int32 -> Int16 -> Int8 -> IO (Ptr C2)+foreign import ccall newC2 :: Int32 -> Ptr C0 -> Int16 -> Int8 -> IO (Ptr C2) foreign import ccall checkFieldsC2 :: Ptr C2 -> Ptr C2 -> IO Int8 foreign import ccall checkOffsetsC2 :: Ptr Int16 -> IO Int8 foreign import ccall getSizeC2 :: IO Int16@@ -134,7 +157,7 @@ foreign import ccall getSizeC4 :: IO Int16 foreign import ccall getAlignmentC4 :: IO Int16 -data C5 = C5 Int32 Int16 Int8 Int8 Int8+data C5 = C5 C0 C0 Int32 Int16 Int8 Int8 Int8     deriving (Show, Eq, Generic, GStorable)  instance Checkable C5 where@@ -142,14 +165,18 @@     checkOffsets   _    offs = (==1) <$> checkOffsetsC5 offs     getSize        a          = fromIntegral <$> getSizeC5     getAlignment   a          = fromIntegral <$> getAlignmentC5-    new (C5 a b c d e) = do-        ptr <- newC5 a b c d e+    new (C5 a b c d e f g) = do+        ptr_a <- newStorable a+        ptr_b <- newStorable b+        ptr <- newC5 ptr_a ptr_b c d e f g+        free ptr_a+        free ptr_b         return ptr  instance Arbitrary C5 where -    arbitrary = C5 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+    arbitrary = C5 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -foreign import ccall newC5 :: Int32 -> Int16 -> Int8 -> Int8 -> Int8 -> IO (Ptr C5)+foreign import ccall newC5 :: Ptr C0 -> Ptr C0 -> Int32 -> Int16 -> Int8 -> Int8 -> Int8 -> IO (Ptr C5) foreign import ccall checkFieldsC5 :: Ptr C5 -> Ptr C5 -> IO Int8 foreign import ccall checkOffsetsC5 :: Ptr Int16 -> IO Int8 foreign import ccall getSizeC5 :: IO Int16@@ -318,7 +345,7 @@ foreign import ccall getSizeC12 :: IO Int16 foreign import ccall getAlignmentC12 :: IO Int16 -data C13 = C13 C12 C12 C12 C12+data C13 = C13 C12 C12 C0 C12 C12     deriving (Show, Eq, Generic, GStorable)  instance Checkable C13 where@@ -326,22 +353,24 @@     checkOffsets   _    offs = (==1) <$> checkOffsetsC13 offs     getSize        a          = fromIntegral <$> getSizeC13     getAlignment   a          = fromIntegral <$> getAlignmentC13-    new (C13 a b c d) = do+    new (C13 a b c d e) = do         ptr_a <- newStorable a         ptr_b <- newStorable b         ptr_c <- newStorable c         ptr_d <- newStorable d-        ptr <- newC13 ptr_a ptr_b ptr_c ptr_d+        ptr_e <- newStorable e+        ptr <- newC13 ptr_a ptr_b ptr_c ptr_d ptr_e         free ptr_a         free ptr_b         free ptr_c         free ptr_d+        free ptr_e         return ptr  instance Arbitrary C13 where -    arbitrary = C13 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+    arbitrary = C13 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -foreign import ccall newC13 :: Ptr C12 -> Ptr C12 -> Ptr C12 -> Ptr C12 -> IO (Ptr C13)+foreign import ccall newC13 :: Ptr C12 -> Ptr C12 -> Ptr C0 -> Ptr C12 -> Ptr C12 -> IO (Ptr C13) foreign import ccall checkFieldsC13 :: Ptr C13 -> Ptr C13 -> IO Int8 foreign import ccall checkOffsetsC13 :: Ptr Int16 -> IO Int8 foreign import ccall getSizeC13 :: IO Int16@@ -401,7 +430,7 @@ foreign import ccall getSizeC15 :: IO Int16 foreign import ccall getAlignmentC15 :: IO Int16 -data C16 = C16 C10 C15 C7+data C16 = C16 C10 C0 C15 C7     deriving (Show, Eq, Generic, GStorable)  instance Checkable C16 where@@ -409,20 +438,22 @@     checkOffsets   _    offs = (==1) <$> checkOffsetsC16 offs     getSize        a          = fromIntegral <$> getSizeC16     getAlignment   a          = fromIntegral <$> getAlignmentC16-    new (C16 a b c) = do+    new (C16 a b c d) = do         ptr_a <- newStorable a         ptr_b <- newStorable b         ptr_c <- newStorable c-        ptr <- newC16 ptr_a ptr_b ptr_c+        ptr_d <- newStorable d+        ptr <- newC16 ptr_a ptr_b ptr_c ptr_d         free ptr_a         free ptr_b         free ptr_c+        free ptr_d         return ptr  instance Arbitrary C16 where -    arbitrary = C16 <$> arbitrary <*> arbitrary <*> arbitrary+    arbitrary = C16 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -foreign import ccall newC16 :: Ptr C10 -> Ptr C15 -> Ptr C7 -> IO (Ptr C16)+foreign import ccall newC16 :: Ptr C10 -> Ptr C0 -> Ptr C15 -> Ptr C7 -> IO (Ptr C16) foreign import ccall checkFieldsC16 :: Ptr C16 -> Ptr C16 -> IO Int8 foreign import ccall checkOffsetsC16 :: Ptr Int16 -> IO Int8 foreign import ccall getSizeC16 :: IO Int16

@@ -3,6 +3,33 @@ #include <stdalign.h> #include <stdlib.h> #include "HsFFI.h"+typedef struct C0{+} C0;++C0 * newC0(){+    C0 * ret = (C0*) malloc(sizeof(C0));+    return ret;+}++void pokeC0(C0* val){+}++int checkOffsetsC0(HsInt16 *offs){+    return 1;+}++int checkFieldsC0(C0* s1, C0* s2){+    return 1; +}++HsInt16 getSizeC0() {+    return sizeof(C0);+}++HsInt16 getAlignmentC0() {+    return alignof(C0);+}+ typedef struct C1{     HsInt32 a;     HsInt32 b;@@ -42,36 +69,41 @@  typedef struct C2{     HsInt32 a;-    HsInt16 b;-    HsInt8 c;+    C0 b;+    HsInt16 c;+    HsInt8 d; } C2; -C2 * newC2(HsInt32 a, HsInt16 b, HsInt8 c){+C2 * newC2(HsInt32 a, C0* b, HsInt16 c, HsInt8 d){     C2 * ret = (C2*) malloc(sizeof(C2));     ret->a = a;-    ret->b = b;+    ret->b = *b;     ret->c = c;+    ret->d = d;     return ret; } -void pokeC2(C2* val, HsInt32 a, HsInt16 b, HsInt8 c){+void pokeC2(C2* val, HsInt32 a, C0* b, HsInt16 c, HsInt8 d){     val->a = a;-    val->b = b;+    val->b = *b;     val->c = c;+    val->d = d; }  int checkOffsetsC2(HsInt16 *offs){     int a = offsetof(C2, a) == offs[0];     int b = offsetof(C2, b) == offs[1];     int c = offsetof(C2, c) == offs[2];-    return a && b && c;+    int d = offsetof(C2, d) == offs[3];+    return a && b && c && d; }  int checkFieldsC2(C2* s1, C2* s2){     int a = s1->a == s2->a;-    int b = s1->b == s2->b;+    int b = checkFieldsC0(&(s1->b),&(s2->b));     int c = s1->c == s2->c;-    return a && b && c;+    int d = s1->d == s2->d;+    return a && b && c && d; }  HsInt16 getSizeC2() {@@ -167,29 +199,35 @@ }  typedef struct C5{-    HsInt32 a;-    HsInt16 b;-    HsInt8 c;-    HsInt8 d;+    C0 a;+    C0 b;+    HsInt32 c;+    HsInt16 d;     HsInt8 e;+    HsInt8 f;+    HsInt8 g; } C5; -C5 * newC5(HsInt32 a, HsInt16 b, HsInt8 c, HsInt8 d, HsInt8 e){+C5 * newC5(C0* a, C0* b, HsInt32 c, HsInt16 d, HsInt8 e, HsInt8 f, HsInt8 g){     C5 * ret = (C5*) malloc(sizeof(C5));-    ret->a = a;-    ret->b = b;+    ret->a = *a;+    ret->b = *b;     ret->c = c;     ret->d = d;     ret->e = e;+    ret->f = f;+    ret->g = g;     return ret; } -void pokeC5(C5* val, HsInt32 a, HsInt16 b, HsInt8 c, HsInt8 d, HsInt8 e){-    val->a = a;-    val->b = b;+void pokeC5(C5* val, C0* a, C0* b, HsInt32 c, HsInt16 d, HsInt8 e, HsInt8 f, HsInt8 g){+    val->a = *a;+    val->b = *b;     val->c = c;     val->d = d;     val->e = e;+    val->f = f;+    val->g = g; }  int checkOffsetsC5(HsInt16 *offs){@@ -198,16 +236,20 @@     int c = offsetof(C5, c) == offs[2];     int d = offsetof(C5, d) == offs[3];     int e = offsetof(C5, e) == offs[4];-    return a && b && c && d && e;+    int f = offsetof(C5, f) == offs[5];+    int g = offsetof(C5, g) == offs[6];+    return a && b && c && d && e && f && g; }  int checkFieldsC5(C5* s1, C5* s2){-    int a = s1->a == s2->a;-    int b = s1->b == s2->b;+    int a = checkFieldsC0(&(s1->a),&(s2->a));+    int b = checkFieldsC0(&(s1->b),&(s2->b));     int c = s1->c == s2->c;     int d = s1->d == s2->d;     int e = s1->e == s2->e;-    return a && b && c && d && e;+    int f = s1->f == s2->f;+    int g = s1->g == s2->g;+    return a && b && c && d && e && f && g; }  HsInt16 getSizeC5() {@@ -515,24 +557,27 @@ typedef struct C13{     C12 a;     C12 b;-    C12 c;+    C0 c;     C12 d;+    C12 e; } C13; -C13 * newC13(C12* a, C12* b, C12* c, C12* d){+C13 * newC13(C12* a, C12* b, C0* c, C12* d, C12* e){     C13 * ret = (C13*) malloc(sizeof(C13));     ret->a = *a;     ret->b = *b;     ret->c = *c;     ret->d = *d;+    ret->e = *e;     return ret; } -void pokeC13(C13* val, C12* a, C12* b, C12* c, C12* d){+void pokeC13(C13* val, C12* a, C12* b, C0* c, C12* d, C12* e){     val->a = *a;     val->b = *b;     val->c = *c;     val->d = *d;+    val->e = *e; }  int checkOffsetsC13(HsInt16 *offs){@@ -540,15 +585,17 @@     int b = offsetof(C13, b) == offs[1];     int c = offsetof(C13, c) == offs[2];     int d = offsetof(C13, d) == offs[3];-    return a && b && c && d;+    int e = offsetof(C13, e) == offs[4];+    return a && b && c && d && e; }  int checkFieldsC13(C13* s1, C13* s2){     int a = checkFieldsC12(&(s1->a),&(s2->a));     int b = checkFieldsC12(&(s1->b),&(s2->b));-    int c = checkFieldsC12(&(s1->c),&(s2->c));+    int c = checkFieldsC0(&(s1->c),&(s2->c));     int d = checkFieldsC12(&(s1->d),&(s2->d));-    return a && b && c && d;+    int e = checkFieldsC12(&(s1->e),&(s2->e));+    return a && b && c && d && e; }  HsInt16 getSizeC13() {@@ -650,36 +697,41 @@  typedef struct C16{     C10 a;-    C15 b;-    C7 c;+    C0 b;+    C15 c;+    C7 d; } C16; -C16 * newC16(C10* a, C15* b, C7* c){+C16 * newC16(C10* a, C0* b, C15* c, C7* d){     C16 * ret = (C16*) malloc(sizeof(C16));     ret->a = *a;     ret->b = *b;     ret->c = *c;+    ret->d = *d;     return ret; } -void pokeC16(C16* val, C10* a, C15* b, C7* c){+void pokeC16(C16* val, C10* a, C0* b, C15* c, C7* d){     val->a = *a;     val->b = *b;     val->c = *c;+    val->d = *d; }  int checkOffsetsC16(HsInt16 *offs){     int a = offsetof(C16, a) == offs[0];     int b = offsetof(C16, b) == offs[1];     int c = offsetof(C16, c) == offs[2];-    return a && b && c;+    int d = offsetof(C16, d) == offs[3];+    return a && b && c && d; }  int checkFieldsC16(C16* s1, C16* s2){     int a = checkFieldsC10(&(s1->a),&(s2->a));-    int b = checkFieldsC15(&(s1->b),&(s2->b));-    int c = checkFieldsC7(&(s1->c),&(s2->c));-    return a && b && c;+    int b = checkFieldsC0(&(s1->b),&(s2->b));+    int c = checkFieldsC15(&(s1->c),&(s2->c));+    int d = checkFieldsC7(&(s1->d),&(s2->d));+    return a && b && c && d; }  HsInt16 getSizeC16() {

@@ -1,1 +1,13 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+import Test.Hspec++import qualified Foreign.Storable.Generic.InternalSpec            as I+import qualified Foreign.Storable.Generic.ToolsSpec               as T+import qualified Foreign.Storable.Generic.Internal.GStorable'Spec as GS1+import qualified Foreign.Storable.Generic.Internal.GStorableSpec  as GS2++++main :: IO ()+main = hspec (I.spec >> T.spec >> GS1.spec >> GS2.spec)++