diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -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 + diff --git a/benchmark/TestCases.hs b/benchmark/TestCases.hs new file mode 100644 --- /dev/null +++ b/benchmark/TestCases.hs @@ -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 diff --git a/derive-storable.cabal b/derive-storable.cabal --- a/derive-storable.cabal +++ b/derive-storable.cabal @@ -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 + diff --git a/src/Foreign/Storable/Generic/Internal.hs b/src/Foreign/Storable/Generic/Internal.hs --- a/src/Foreign/Storable/Generic/Internal.hs +++ b/src/Foreign/Storable/Generic/Internal.hs @@ -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' #-} diff --git a/test/Basic/MemoryCSpec.hs b/test/Basic/MemoryCSpec.hs --- a/test/Basic/MemoryCSpec.hs +++ b/test/Basic/MemoryCSpec.hs @@ -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) diff --git a/test/Basic/TestCases.hs b/test/Basic/TestCases.hs --- a/test/Basic/TestCases.hs +++ b/test/Basic/TestCases.hs @@ -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 diff --git a/test/Basic/cbits/TestCases.c b/test/Basic/cbits/TestCases.c --- a/test/Basic/cbits/TestCases.c +++ b/test/Basic/cbits/TestCases.c @@ -3,6 +3,33 @@ #include #include #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() { diff --git a/test/Spec/Spec.hs b/test/Spec/Spec.hs --- a/test/Spec/Spec.hs +++ b/test/Spec/Spec.hs @@ -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) + +