diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2016 Mateusz Kloczko + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/derive-storable.cabal b/derive-storable.cabal new file mode 100644 --- /dev/null +++ b/derive-storable.cabal @@ -0,0 +1,83 @@ +-- Initial derive-storable.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: derive-storable + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Deriving Storable instances using generics. + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Mateusz Kloczko + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: mateusz.p.kloczko@gmail.com + +-- A copyright notice. +-- copyright: + +category: FFI + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Foreign.Storable.Generic, Foreign.Storable.Generic.Tools + , Foreign.Storable.Generic.Internal, Foreign.Storable.Generic.Instances + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.8 && <4.10 + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 + + +test-suite c_alignment + type: exitcode-stdio-1.0 + + hs-source-dirs: src, test/Basic, test/Basic/cbits + c-sources: test/Basic/cbits/TestCases.c + main-is: MemoryCSpec.hs + build-depends: base >= 4.8 && <4.10, hspec == 2.2.* ,QuickCheck == 2.8.*, generic-storable + + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + hs-source-dirs: src/ test/Spec test/Basic test/GenericRep/ + Main-is: Spec.hs + build-depends: base >= 4.8 && < 4.10, generic-storable, hspec == 2.2.*, QuickCheck == 2.8.* + + default-language: Haskell2010 diff --git a/src/Foreign/Storable/Generic.hs b/src/Foreign/Storable/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Storable/Generic.hs @@ -0,0 +1,42 @@ +{-| +Module : Foreign.Storable.Generic +Copyright : (c) Mateusz Kłoczko, 2016 +License : MIT +Maintainer : mateusz.p.kloczko@gmail.com +Stability : experimental +Portability : portable + + + +-} + +{-#LANGUAGE FlexibleInstances #-} +{-#LANGUAGE FlexibleContexts #-} +{-#LANGUAGE TypeOperators #-} +{-#LANGUAGE ScopedTypeVariables #-} +{-#LANGUAGE UndecidableInstances #-} + + +module Foreign.Storable.Generic (GStorable (..), Storable(..)) where + + + +import Foreign.Storable (Storable(..)) + +import Foreign.Storable.Generic.Internal (GStorable (..)) +import Foreign.Storable.Generic.Instances + + +------Association to Storable class------- + +instance {-# OVERLAPS #-} (GStorable a) => (Storable a) where + {-# INLINE sizeOf #-} + sizeOf = gsizeOf + {-# INLINE alignment #-} + alignment = galignment + {-# INLINE peekByteOff #-} + peekByteOff = gpeekByteOff + {-# INLINE pokeByteOff #-} + pokeByteOff = gpokeByteOff + + diff --git a/src/Foreign/Storable/Generic/Instances.hs b/src/Foreign/Storable/Generic/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Storable/Generic/Instances.hs @@ -0,0 +1,105 @@ +{-| +Module : Foreign.Storable.Generic.Instances +Copyright : (c) Mateusz Kłoczko, 2016 +License : MIT +Maintainer : mateusz.p.kloczko@gmail.com +Stability : experimental +Portability : portable + + +-} + +{-# LANGUAGE CPP #-} +module Foreign.Storable.Generic.Instances () where + +import Data.Int +import Data.Word +import Foreign.C.Types +import Foreign.Ptr +import Foreign.StablePtr +import Foreign.Storable +import Foreign.Storable.Generic.Internal +import GHC.Fingerprint.Type +import System.Posix.Types +import Data.Ratio (Ratio) + +#define MakeGStorable(Type) \ +instance GStorable Type where \ + {-#INLINE gsizeOf #-} \ +; gsizeOf = sizeOf \ +; {-#INLINE galignment #-} \ +; galignment = alignment \ +; {-#INLINE gpeekByteOff #-} \ +; gpeekByteOff = peekByteOff \ +; {-#INLINE gpokeByteOff #-} \ +; gpokeByteOff = pokeByteOff \ + +-- Haskell primitives +MakeGStorable(Bool) +MakeGStorable(Char) +MakeGStorable(Double) +MakeGStorable(Float) + +MakeGStorable(Int) +MakeGStorable(Int8) +MakeGStorable(Int16) +MakeGStorable(Int32) +MakeGStorable(Int64) + +MakeGStorable(Word) +MakeGStorable(Word8) +MakeGStorable(Word16) +MakeGStorable(Word32) +MakeGStorable(Word64) + +MakeGStorable (Fingerprint) + +-- C primitives +MakeGStorable (CUIntMax) +MakeGStorable (CIntMax) +MakeGStorable (CSUSeconds) +MakeGStorable (CUSeconds) +MakeGStorable (CTime) +MakeGStorable (CClock) +MakeGStorable (CSigAtomic) +MakeGStorable (CPtrdiff) +MakeGStorable (CDouble) +MakeGStorable (CFloat) +MakeGStorable (CULLong) +MakeGStorable (CLLong) +MakeGStorable (CULong) +MakeGStorable (CLong) +MakeGStorable (CUInt) +MakeGStorable (CInt) +MakeGStorable (CUShort) +MakeGStorable (CShort) +MakeGStorable (CUChar) +MakeGStorable (CSChar) +MakeGStorable (CChar) + +-- Ptr +MakeGStorable (IntPtr) +MakeGStorable (WordPtr) + +MakeGStorable ((StablePtr a)) +MakeGStorable ((Ptr a)) +MakeGStorable ((FunPtr a)) + +-- Posix +MakeGStorable (Fd) +MakeGStorable (CRLim) +MakeGStorable (CTcflag) +MakeGStorable (CSpeed) +MakeGStorable (CCc) +MakeGStorable (CUid) +MakeGStorable (CNlink) +MakeGStorable (CGid) +MakeGStorable (CSsize) +MakeGStorable (CPid) +MakeGStorable (COff) +MakeGStorable (CMode) +MakeGStorable (CIno) +MakeGStorable (CDev) + + + diff --git a/src/Foreign/Storable/Generic/Internal.hs b/src/Foreign/Storable/Generic/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Storable/Generic/Internal.hs @@ -0,0 +1,219 @@ +{-| +Module : Foreign.Storable.Generic.Internal +Copyright : (c) Mateusz Kłoczko, 2016 +License : MIT +Maintainer : mateusz.p.kloczko@gmail.com +Stability : experimental +Portability : portable + + +-} + +{-#LANGUAGE FlexibleInstances #-} +{-#LANGUAGE FlexibleContexts #-} +{-#LANGUAGE DefaultSignatures #-} +{-#LANGUAGE TypeOperators #-} +{-#LANGUAGE ScopedTypeVariables #-} +{-#LANGUAGE UndecidableInstances #-} + +module Foreign.Storable.Generic.Internal ( + GStorable'(..), + GStorable (..), + internalSizeOf, + internalAlignment, + internalPeekByteOff, + internalPokeByteOff, + internalOffsets + ) where + +import GHC.Generics +import Foreign.Ptr +import Foreign.Storable +import Foreign.Marshal.Alloc +import Foreign.C.Types + +import Data.Int + +import Debug.Trace + +import Foreign.Storable.Generic.Tools + +import GHC.Exts + +-- Defining the generics --- + +class GStorable' f where + -- | Read the element at a given offset. Additional information about the offests + -- of the subfields are needed. + gpeekByteOff' :: [Int] -- ^ List of fields' offsets for the type/struct. + -> Int -- ^ The index. Used to obtain the correct offset + -> Ptr b -- ^ The pointer to the type/struct. + -> Int -- ^ Global offset. + -> IO (f a) -- ^ The result, wrapped in GHC.Generic metadata. + -- | Write the element at a given offset. Additional information about the offests + -- of the subfields are needed. + gpokeByteOff' :: [Int] -- ^ List of fields' offsets for the type/struct. + -> Int -- ^ The index. Used to obtain the correct offset. + -> Ptr b -- ^ The pointer to the type/struct. + -> Int -- ^ Global offset. + -> (f a) -- ^ The element to write, wrapped in GHC.Generic metadata. + -> IO () + + -- | Calculates the number of type's/struct's fields. + gnumberOf' :: f a -- ^ GHC.Generic information about a given type/struct. + -> Int -- ^ Size. + + -- | Calculates the sizes of type's/struct's fields. + glistSizeOf' :: f a -- ^ GHC.Generic information about a given type/struct. + -> [Size] -- ^ List of sizes. + + -- | Calculates the alignments of type's/struct's fields. + glistAlignment' :: f a -- ^ GHC.Generic information about a given type/struct. + -> [Alignment] -- ^ List of alignments. + + +instance (GStorable' f) => GStorable' (M1 i t f) where + -- Wrap the peeked value in metadata. + {-# INLINE gpeekByteOff' #-} + gpeekByteOff' offsets ix ptr offset = M1 <$> gpeekByteOff' offsets ix ptr offset + -- Discard the metadata and go further. + {-# INLINE gpokeByteOff' #-} + gpokeByteOff' offsets ix ptr offset (M1 x) = gpokeByteOff' offsets ix ptr offset x + + + gnumberOf' (M1 v) = gnumberOf' v + glistSizeOf' _ = glistSizeOf' (undefined :: f p) + glistAlignment' _ = glistAlignment' (undefined :: f p) + +instance (GStorable' f, GStorable' g) => GStorable' (f :*: g) where + -- Tree-like traversal for reading the type. + {-# INLINE gpeekByteOff' #-} + gpeekByteOff' offsets ix ptr offset = (:*:) <$> peeker new_ix <*> peeker ix + where new_ix = ix - n2 -- The new index for the left part of the tree. + n2 = gnumberOf' (undefined :: g a) -- Number of elements for the right part of the tree + peeker n_ix = gpeekByteOff' offsets n_ix ptr offset -- gpeekByteOff' wrapped to peek into subtrees. + -- Tree like traversal for writing the type. + {-# INLINE gpokeByteOff' #-} + gpokeByteOff' offsets ix ptr offset (x :*: y) = peeker new_ix x >> peeker ix y + where new_ix = ix - n2 + n2 = gnumberOf' (undefined :: g a) -- Number of elements for the right part of the tree. + peeker n_ix z = gpokeByteOff' offsets n_ix ptr offset z -- gpokeByteOff' wrapped to peek into the subtree + + + + + gnumberOf' _ = gnumberOf' (undefined :: f a) + gnumberOf' (undefined :: g a) + -- Concatenate the lists. + glistSizeOf' _ = glistSizeOf' (undefined :: f a) ++ glistSizeOf' (undefined :: g a) + -- Concatenate the lists. + glistAlignment' _ = glistAlignment' (undefined :: f a) ++ glistAlignment' (undefined :: g a) + +instance (GStorable a) => GStorable' (K1 i a) where + {-# INLINE gpeekByteOff' #-} + gpeekByteOff' offsets ix ptr offset = K1 <$> gpeekByteOff ptr (off1 + offset) + where off1 = inline (offsets !! ix) + {-# INLINE gpokeByteOff' #-} + gpokeByteOff' offsets ix ptr offset (K1 x) = gpokeByteOff ptr (off1 + offset) x + where off1 = inline (offsets !! ix) + + + -- When we use the contructor, just return one. + gnumberOf' _ = 1 + -- When the constructor is used, return the size of + -- the constructed type in a list. + glistSizeOf' _ = [gsizeOf (undefined :: a)] + -- When the constructor is used, return the alignment of + -- the constructed type in a list. + glistAlignment' _ = [galignment (undefined :: a)] + + +-- These functions were moved outside GStorable type class. +-- They take generic representations as input. + +{-# INLINE internalSizeOf #-} +-- | Calculates the size of generic data-type. +internalSizeOf :: forall f p. (GStorable' f) + => f p -- ^ Generic representation + -> Int -- ^ Resulting size +internalSizeOf _ = calcSize $ zip sizes aligns + where sizes = glistSizeOf' (undefined :: f p) + aligns = glistAlignment' (undefined :: f p) + +{-# INLINE internalAlignment #-} +-- | Calculates the alignment of generic data-type. +internalAlignment :: forall f p. (GStorable' f) + => f p -- ^ Generic representation + -> Alignment -- ^ Resulting alignment +internalAlignment _ = calcAlignment aligns + where aligns = glistAlignment' (undefined :: f p) + +{-# INLINE internalPeekByteOff #-} +-- | View the variable under a pointer, with offset. +internalPeekByteOff :: forall f p b. (GStorable' f) + => Ptr b -- ^ Pointer to peek + -> Offset -- ^ Offset + -> IO (f p) -- ^ Resulting generic representation +internalPeekByteOff ptr off = gpeekByteOff' offsets ix ptr off + where offsets = internalOffsets (undefined :: f p) + ix = gnumberOf' (undefined :: f p) - 1 + +{-# INLINE internalPokeByteOff #-} +-- | Write the variable under the pointer, with offset. +internalPokeByteOff :: forall f p b. (GStorable' f) + => Ptr b -- ^ Pointer to write to + -> Offset -- ^ Offset + -> f p -- ^ Written generic representation + -> IO () +internalPokeByteOff ptr off rep = gpokeByteOff' offsets ix ptr off rep + where offsets = internalOffsets (undefined :: f p) + ix = gnumberOf' (undefined :: f p) - 1 + +{-# INLINE internalOffsets #-} +-- | Obtain the list of offsets +internalOffsets :: forall f p. (GStorable' f) + => f p -- Generic representation + -> [Offset] -- List of offsets +internalOffsets _ = calcOffsets $ zip sizes aligns + where sizes = glistSizeOf' (undefined :: f p) + aligns= glistAlignment' (undefined :: f p) + +-- | The class uses the default Generic based implementations to +-- provide Storable instances for types made from primitive types. +-- Does not work on Algebraic Data Types with more than one constructor. +class GStorable a where + -- | Calculate the size of the type. + {-# INLINE gsizeOf #-} + gsizeOf :: a -- ^ Element of a given type. Can be undefined. + -> Int -- ^ Size. + default gsizeOf :: (Generic a, GStorable' (Rep a)) + => a -> Int + gsizeOf _ = internalSizeOf (undefined :: Rep a p) + + -- | Calculate the alignment of the type. + {-# INLINE galignment #-} + galignment :: a -- ^ Element of a given type. Can be undefined + -> Int -- ^ Alignment. + default galignment :: (Generic a, GStorable' (Rep a)) + => a -> Int + galignment _ = internalAlignment (undefined :: Rep a p) + + -- | Read the variable from a given pointer. + gpeekByteOff :: Ptr b -- ^ Pointer to the variable + -> Int -- ^ Offset + -> IO a -- ^ Returned variable. + default gpeekByteOff :: (Generic a, GStorable' (Rep a)) + => Ptr b -> Int -> IO a + {-# INLINE gpeekByteOff #-} + gpeekByteOff ptr offset = to <$> internalPeekByteOff ptr offset + + -- | Write the variable to a pointer. + gpokeByteOff :: Ptr b -- ^ Pointer to the variable. + -> Int -- ^ Offset. + -> a -- ^ The variable + -> IO () + default gpokeByteOff :: (Generic a, GStorable' (Rep a)) + => Ptr b -> Int -> a -> IO () + {-# INLINE gpokeByteOff #-} + gpokeByteOff ptr offset x = internalPokeByteOff ptr offset (from x) + + diff --git a/src/Foreign/Storable/Generic/Tools.hs b/src/Foreign/Storable/Generic/Tools.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Storable/Generic/Tools.hs @@ -0,0 +1,106 @@ +{-| +Module : Foreign.Storable.Generic.Tools +Copyright : (c) Mateusz Kłoczko, 2016 +License : MIT +Maintainer : mateusz.p.kloczko@gmail.com +Stability : experimental +Portability : portable + + +-} + + +{-#LANGUAGE FlexibleInstances #-} +{-#LANGUAGE FlexibleContexts #-} +{-#LANGUAGE TypeOperators #-} +{-#LANGUAGE ScopedTypeVariables #-} +{-#LANGUAGE UndecidableInstances #-} + +module Foreign.Storable.Generic.Tools ( + Size, + Alignment, + Offset, + Filling(..), + calcOffsets, + calcSize, + calcAlignment, + getFilling +) where + +import Data.List + + +-- | The datatype representing the memory layout of a given struct. +data Filling = Size Int | Padding Int deriving(Show, Eq) + +-- | Checks whether the size or padding are zero. +not_zero :: Filling -> Bool +not_zero (Size 0) = False +not_zero (Padding 0) = False +not_zero _ = True + + +type Size = Int +type Alignment = Int +type Offset = Int + + + +-- | Get the memory layout of a given type/struct. Used mostly as debug information. +getFilling :: [(Size,Alignment)] -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)] + -> [Filling] -- ^ List representing the memory layout. [Filling] +getFilling size_align = reverse $ filter not_zero $ getFilling' (ordered ++ [(gl_size,0)]) 0 0 [] + where offsets = calcOffsets size_align :: [Offset] + sizes = map fst size_align :: [Size] + ordered = sortBy (\(o1,_) (o2,_) -> compare o1 o2) $ -- Needs to be sorted in case the fields are rearranged. + zip offsets sizes :: [(Offset,Size)] + gl_size = calcSize size_align :: Offset -- This variable is used as offset + +getFilling' :: [(Offset, Size)] -- ^ List of struct's fields' offsets and sizes + -> Size -- ^ Size of the previous element + -> Offset -- ^ Offest of the previous element + -> [Filling] -- ^ Accumulator: List of filling + -> [Filling] -- ^ Returned list of fillings. +getFilling' [] _ _ acc = acc +getFilling' ((o2,s2):rest) s1 o1 acc = getFilling' rest s2 o2 (Size s2 : Padding ((o2-o1) - s1) : acc ) + +{-# NOINLINE calcOffsets #-} +-- | Calculates the memory offset of type's/struct's fields. +calcOffsets :: [(Size, Alignment)] -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)] + -> [Offset] -- ^ List representing the offests of the type's/struct's fields. [Int] +calcOffsets [] = [] +calcOffsets size_align = reverse $ fst $ calcOffsets' size_align 0 [] + + + +{-# NOINLINE calcOffsets' #-} +calcOffsets' :: [(Size, Alignment)] -- ^ List of struct's fields' sizes and alignments + -> Int -- ^ The intermediate variable between the current and previous iteration. + -> [Offset] -- ^ Accumulator + -> ([Offset], Int) -- ^ List of offsets and the last intermediate value. +calcOffsets' [] inter acc = (acc, inter) +calcOffsets' ((s,a):rest) inter acc = calcOffsets' rest (last_off + s) (last_off: acc) + where p = (a - inter) `mod` a -- Padding + last_off = inter + p :: Offset + + +{-# NOINLINE calcSize #-} +-- | Calculates the size of the type/struct. +calcSize :: [(Size, Alignment)] -- ^ List of sizes and aligments of the type's/struct's fields. [(Int,Int)]. + -> Size -- ^ The returned size. Int +calcSize size_align = inter + ((glob_align - inter) `mod` glob_align) + where glob_align = calcAlignment $ map snd size_align + inter = snd $ calcOffsets' size_align 0 [] + +{-# NOINLINE calcAlignment #-} +-- | Calculate the alignment of a struct. +calcAlignment :: [Alignment] -- ^ List of struct's fields' alignments. + -> Alignment -- ^ The resulting alignment. +calcAlignment aligns = calcAlignment' aligns 1 + + +calcAlignment' :: [Alignment] -- ^ List of alignments + -> Alignment -- ^ Accumulator + -> Alignment -- ^ The resulting alignment. +calcAlignment' [] glob = glob +calcAlignment' (al:aligns) glob = calcAlignment' aligns (max glob al) diff --git a/test/Basic/MemoryCSpec.hs b/test/Basic/MemoryCSpec.hs new file mode 100644 --- /dev/null +++ b/test/Basic/MemoryCSpec.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts#-} +module Main where + + +-- Tested module. +import TestCases + +-- Test libraries +import Test.Hspec +import Test.QuickCheck + +-- Helpers +import Foreign.Marshal.Array +import Foreign.Storable + + +same_alignment a = getAlignment a `shouldReturn` alignment a +same_size a = getSize a `shouldReturn` sizeOf a +same_offsets a = do + let offsets = goffsets a + ptr <- mallocArray $ length offsets + pokeArray ptr offsets + checkOffsets a ptr `shouldReturn` True + +same_fields a = do + ptr1 <- newStorable a + ptr2 <- new a + checkFields ptr1 ptr2 `shouldReturn` True +main = hspec $ do + describe "Test for same size" $ do + it "C1" $ property $ (same_size :: C1 -> Expectation) + it "C2" $ property $ (same_size :: C2 -> Expectation) + it "C3" $ property $ (same_size :: C3 -> Expectation) + it "C4" $ property $ (same_size :: C4 -> Expectation) + it "C5" $ property $ (same_size :: C5 -> Expectation) + it "C6" $ property $ (same_size :: C6 -> Expectation) + it "C7" $ property $ (same_size :: C7 -> Expectation) + it "C8" $ property $ (same_size :: C8 -> Expectation) + it "C9" $ property $ (same_size :: C9 -> Expectation) + it "C10" $ property $ (same_size :: C10 -> Expectation) + it "C11" $ property $ (same_size :: C11 -> Expectation) + it "C12" $ property $ (same_size :: C12 -> Expectation) + it "C13" $ property $ (same_size :: C13 -> Expectation) + it "C14" $ property $ (same_size :: C14 -> Expectation) + it "C15" $ property $ (same_size :: C15 -> Expectation) + it "C16" $ property $ (same_size :: C16 -> Expectation) + it "C17" $ property $ (same_size :: C17 -> Expectation) + it "C18" $ property $ (same_size :: C18 -> Expectation) + it "C19" $ property $ (same_size :: C19 -> Expectation) + it "C20" $ property $ (same_size :: C20 -> Expectation) + describe "Test for same alignment" $ do + it "C1" $ property $ (same_alignment :: C1 -> Expectation) + it "C2" $ property $ (same_alignment :: C2 -> Expectation) + it "C3" $ property $ (same_alignment :: C3 -> Expectation) + it "C4" $ property $ (same_alignment :: C4 -> Expectation) + it "C5" $ property $ (same_alignment :: C5 -> Expectation) + it "C6" $ property $ (same_alignment :: C6 -> Expectation) + it "C7" $ property $ (same_alignment :: C7 -> Expectation) + it "C8" $ property $ (same_alignment :: C8 -> Expectation) + it "C9" $ property $ (same_alignment :: C9 -> Expectation) + it "C10" $ property $ (same_alignment :: C10 -> Expectation) + it "C11" $ property $ (same_alignment :: C11 -> Expectation) + it "C12" $ property $ (same_alignment :: C12 -> Expectation) + it "C13" $ property $ (same_alignment :: C13 -> Expectation) + it "C14" $ property $ (same_alignment :: C14 -> Expectation) + it "C15" $ property $ (same_alignment :: C15 -> Expectation) + it "C16" $ property $ (same_alignment :: C16 -> Expectation) + it "C17" $ property $ (same_alignment :: C17 -> Expectation) + it "C18" $ property $ (same_alignment :: C18 -> Expectation) + it "C19" $ property $ (same_alignment :: C19 -> Expectation) + it "C20" $ property $ (same_alignment :: C20 -> Expectation) + describe "Test for same offsets" $ do + it "C1" $ property $ (same_offsets :: C1 -> Expectation) + it "C2" $ property $ (same_offsets :: C2 -> Expectation) + it "C3" $ property $ (same_offsets :: C3 -> Expectation) + it "C4" $ property $ (same_offsets :: C4 -> Expectation) + it "C5" $ property $ (same_offsets :: C5 -> Expectation) + it "C6" $ property $ (same_offsets :: C6 -> Expectation) + it "C7" $ property $ (same_offsets :: C7 -> Expectation) + it "C8" $ property $ (same_offsets :: C8 -> Expectation) + it "C9" $ property $ (same_offsets :: C9 -> Expectation) + it "C10" $ property $ (same_offsets :: C10 -> Expectation) + it "C11" $ property $ (same_offsets :: C11 -> Expectation) + it "C12" $ property $ (same_offsets :: C12 -> Expectation) + it "C13" $ property $ (same_offsets :: C13 -> Expectation) + it "C14" $ property $ (same_offsets :: C14 -> Expectation) + it "C15" $ property $ (same_offsets :: C15 -> Expectation) + it "C16" $ property $ (same_offsets :: C16 -> Expectation) + it "C17" $ property $ (same_offsets :: C17 -> Expectation) + it "C18" $ property $ (same_offsets :: C18 -> Expectation) + it "C19" $ property $ (same_offsets :: C19 -> Expectation) + it "C20" $ property $ (same_offsets :: C20 -> Expectation) + describe "Test for same fields" $ do + it "C1" $ property $ (same_fields :: C1 -> Expectation) + it "C2" $ property $ (same_fields :: C2 -> Expectation) + it "C3" $ property $ (same_fields :: C3 -> Expectation) + it "C4" $ property $ (same_fields :: C4 -> Expectation) + it "C5" $ property $ (same_fields :: C5 -> Expectation) + it "C6" $ property $ (same_fields :: C6 -> Expectation) + it "C7" $ property $ (same_fields :: C7 -> Expectation) + it "C8" $ property $ (same_fields :: C8 -> Expectation) + it "C9" $ property $ (same_fields :: C9 -> Expectation) + it "C10" $ property $ (same_fields :: C10 -> Expectation) + it "C11" $ property $ (same_fields :: C11 -> Expectation) + it "C12" $ property $ (same_fields :: C12 -> Expectation) + it "C13" $ property $ (same_fields :: C13 -> Expectation) + it "C14" $ property $ (same_fields :: C14 -> Expectation) + it "C15" $ property $ (same_fields :: C15 -> Expectation) + it "C16" $ property $ (same_fields :: C16 -> Expectation) + it "C17" $ property $ (same_fields :: C17 -> Expectation) + it "C18" $ property $ (same_fields :: C18 -> Expectation) + it "C19" $ property $ (same_fields :: C19 -> Expectation) + it "C20" $ property $ (same_fields :: C20 -> Expectation) diff --git a/test/Basic/cbits/TestCases.c b/test/Basic/cbits/TestCases.c new file mode 100644 --- /dev/null +++ b/test/Basic/cbits/TestCases.c @@ -0,0 +1,870 @@ +#include +#include +#include +#include +#include "HsFFI.h" +typedef struct C1{ + HsInt32 a; + HsInt32 b; +} C1; + +C1 * newC1(HsInt32 a, HsInt32 b){ + C1 * ret = (C1*) malloc(sizeof(C1)); + ret->a = a; + ret->b = b; + return ret; +} + +void pokeC1(C1* val, HsInt32 a, HsInt32 b){ + val->a = a; + val->b = b; +} + +int checkOffsetsC1(HsInt16 *offs){ + int a = offsetof(C1, a) == offs[0]; + int b = offsetof(C1, b) == offs[1]; + return a && b; +} + +int checkFieldsC1(C1* s1, C1* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + return a && b; +} + +HsInt16 getSizeC1() { + return sizeof(C1); +} + +HsInt16 getAlignmentC1() { + return alignof(C1); +} + +typedef struct C2{ + HsInt32 a; + HsInt16 b; + HsInt8 c; +} C2; + +C2 * newC2(HsInt32 a, HsInt16 b, HsInt8 c){ + C2 * ret = (C2*) malloc(sizeof(C2)); + ret->a = a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC2(C2* val, HsInt32 a, HsInt16 b, HsInt8 c){ + val->a = a; + val->b = b; + val->c = c; +} + +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 checkFieldsC2(C2* s1, C2* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC2() { + return sizeof(C2); +} + +HsInt16 getAlignmentC2() { + return alignof(C2); +} + +typedef struct C3{ + HsInt32 a; + HsInt8 b; + HsInt16 c; +} C3; + +C3 * newC3(HsInt32 a, HsInt8 b, HsInt16 c){ + C3 * ret = (C3*) malloc(sizeof(C3)); + ret->a = a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC3(C3* val, HsInt32 a, HsInt8 b, HsInt16 c){ + val->a = a; + val->b = b; + val->c = c; +} + +int checkOffsetsC3(HsInt16 *offs){ + int a = offsetof(C3, a) == offs[0]; + int b = offsetof(C3, b) == offs[1]; + int c = offsetof(C3, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC3(C3* s1, C3* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC3() { + return sizeof(C3); +} + +HsInt16 getAlignmentC3() { + return alignof(C3); +} + +typedef struct C4{ + HsInt32 a; + HsInt8 b; + HsInt8 c; +} C4; + +C4 * newC4(HsInt32 a, HsInt8 b, HsInt8 c){ + C4 * ret = (C4*) malloc(sizeof(C4)); + ret->a = a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC4(C4* val, HsInt32 a, HsInt8 b, HsInt8 c){ + val->a = a; + val->b = b; + val->c = c; +} + +int checkOffsetsC4(HsInt16 *offs){ + int a = offsetof(C4, a) == offs[0]; + int b = offsetof(C4, b) == offs[1]; + int c = offsetof(C4, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC4(C4* s1, C4* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC4() { + return sizeof(C4); +} + +HsInt16 getAlignmentC4() { + return alignof(C4); +} + +typedef struct C5{ + HsInt32 a; + HsInt16 b; + HsInt8 c; + HsInt8 d; + HsInt8 e; +} C5; + +C5 * newC5(HsInt32 a, HsInt16 b, HsInt8 c, HsInt8 d, HsInt8 e){ + C5 * ret = (C5*) malloc(sizeof(C5)); + ret->a = a; + ret->b = b; + ret->c = c; + ret->d = d; + ret->e = e; + return ret; +} + +void pokeC5(C5* val, HsInt32 a, HsInt16 b, HsInt8 c, HsInt8 d, HsInt8 e){ + val->a = a; + val->b = b; + val->c = c; + val->d = d; + val->e = e; +} + +int checkOffsetsC5(HsInt16 *offs){ + int a = offsetof(C5, a) == offs[0]; + int b = offsetof(C5, b) == offs[1]; + 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 checkFieldsC5(C5* s1, C5* s2){ + int a = s1->a == s2->a; + int b = 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; +} + +HsInt16 getSizeC5() { + return sizeof(C5); +} + +HsInt16 getAlignmentC5() { + return alignof(C5); +} + +typedef struct C6{ + HsInt64 a; + HsInt8 b; + HsInt64 c; +} C6; + +C6 * newC6(HsInt64 a, HsInt8 b, HsInt64 c){ + C6 * ret = (C6*) malloc(sizeof(C6)); + ret->a = a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC6(C6* val, HsInt64 a, HsInt8 b, HsInt64 c){ + val->a = a; + val->b = b; + val->c = c; +} + +int checkOffsetsC6(HsInt16 *offs){ + int a = offsetof(C6, a) == offs[0]; + int b = offsetof(C6, b) == offs[1]; + int c = offsetof(C6, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC6(C6* s1, C6* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC6() { + return sizeof(C6); +} + +HsInt16 getAlignmentC6() { + return alignof(C6); +} + +typedef struct C7{ + C1 a; + HsInt32 b; +} C7; + +C7 * newC7(C1* a, HsInt32 b){ + C7 * ret = (C7*) malloc(sizeof(C7)); + ret->a = *a; + ret->b = b; + return ret; +} + +void pokeC7(C7* val, C1* a, HsInt32 b){ + val->a = *a; + val->b = b; +} + +int checkOffsetsC7(HsInt16 *offs){ + int a = offsetof(C7, a) == offs[0]; + int b = offsetof(C7, b) == offs[1]; + return a && b; +} + +int checkFieldsC7(C7* s1, C7* s2){ + int a = checkFieldsC1(&(s1->a),&(s2->a)); + int b = s1->b == s2->b; + return a && b; +} + +HsInt16 getSizeC7() { + return sizeof(C7); +} + +HsInt16 getAlignmentC7() { + return alignof(C7); +} + +typedef struct C8{ + C2 a; + HsInt8 b; + C4 c; +} C8; + +C8 * newC8(C2* a, HsInt8 b, C4* c){ + C8 * ret = (C8*) malloc(sizeof(C8)); + ret->a = *a; + ret->b = b; + ret->c = *c; + return ret; +} + +void pokeC8(C8* val, C2* a, HsInt8 b, C4* c){ + val->a = *a; + val->b = b; + val->c = *c; +} + +int checkOffsetsC8(HsInt16 *offs){ + int a = offsetof(C8, a) == offs[0]; + int b = offsetof(C8, b) == offs[1]; + int c = offsetof(C8, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC8(C8* s1, C8* s2){ + int a = checkFieldsC2(&(s1->a),&(s2->a)); + int b = s1->b == s2->b; + int c = checkFieldsC4(&(s1->c),&(s2->c)); + return a && b && c; +} + +HsInt16 getSizeC8() { + return sizeof(C8); +} + +HsInt16 getAlignmentC8() { + return alignof(C8); +} + +typedef struct C9{ + C5 a; + HsInt8 b; + HsInt8 c; + HsInt8 d; +} C9; + +C9 * newC9(C5* a, HsInt8 b, HsInt8 c, HsInt8 d){ + C9 * ret = (C9*) malloc(sizeof(C9)); + ret->a = *a; + ret->b = b; + ret->c = c; + ret->d = d; + return ret; +} + +void pokeC9(C9* val, C5* a, HsInt8 b, HsInt8 c, HsInt8 d){ + val->a = *a; + val->b = b; + val->c = c; + val->d = d; +} + +int checkOffsetsC9(HsInt16 *offs){ + int a = offsetof(C9, a) == offs[0]; + int b = offsetof(C9, b) == offs[1]; + int c = offsetof(C9, c) == offs[2]; + int d = offsetof(C9, d) == offs[3]; + return a && b && c && d; +} + +int checkFieldsC9(C9* s1, C9* s2){ + int a = checkFieldsC5(&(s1->a),&(s2->a)); + int b = s1->b == s2->b; + int c = s1->c == s2->c; + int d = s1->d == s2->d; + return a && b && c && d; +} + +HsInt16 getSizeC9() { + return sizeof(C9); +} + +HsInt16 getAlignmentC9() { + return alignof(C9); +} + +typedef struct C10{ + C8 a; + HsInt64 b; + C1 c; +} C10; + +C10 * newC10(C8* a, HsInt64 b, C1* c){ + C10 * ret = (C10*) malloc(sizeof(C10)); + ret->a = *a; + ret->b = b; + ret->c = *c; + return ret; +} + +void pokeC10(C10* val, C8* a, HsInt64 b, C1* c){ + val->a = *a; + val->b = b; + val->c = *c; +} + +int checkOffsetsC10(HsInt16 *offs){ + int a = offsetof(C10, a) == offs[0]; + int b = offsetof(C10, b) == offs[1]; + int c = offsetof(C10, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC10(C10* s1, C10* s2){ + int a = checkFieldsC8(&(s1->a),&(s2->a)); + int b = s1->b == s2->b; + int c = checkFieldsC1(&(s1->c),&(s2->c)); + return a && b && c; +} + +HsInt16 getSizeC10() { + return sizeof(C10); +} + +HsInt16 getAlignmentC10() { + return alignof(C10); +} + +typedef struct C11{ + C10 a; + C10 b; +} C11; + +C11 * newC11(C10* a, C10* b){ + C11 * ret = (C11*) malloc(sizeof(C11)); + ret->a = *a; + ret->b = *b; + return ret; +} + +void pokeC11(C11* val, C10* a, C10* b){ + val->a = *a; + val->b = *b; +} + +int checkOffsetsC11(HsInt16 *offs){ + int a = offsetof(C11, a) == offs[0]; + int b = offsetof(C11, b) == offs[1]; + return a && b; +} + +int checkFieldsC11(C11* s1, C11* s2){ + int a = checkFieldsC10(&(s1->a),&(s2->a)); + int b = checkFieldsC10(&(s1->b),&(s2->b)); + return a && b; +} + +HsInt16 getSizeC11() { + return sizeof(C11); +} + +HsInt16 getAlignmentC11() { + return alignof(C11); +} + +typedef struct C12{ + HsInt64 a; + HsInt64 b; + HsInt64 c; + HsInt64 d; +} C12; + +C12 * newC12(HsInt64 a, HsInt64 b, HsInt64 c, HsInt64 d){ + C12 * ret = (C12*) malloc(sizeof(C12)); + ret->a = a; + ret->b = b; + ret->c = c; + ret->d = d; + return ret; +} + +void pokeC12(C12* val, HsInt64 a, HsInt64 b, HsInt64 c, HsInt64 d){ + val->a = a; + val->b = b; + val->c = c; + val->d = d; +} + +int checkOffsetsC12(HsInt16 *offs){ + int a = offsetof(C12, a) == offs[0]; + int b = offsetof(C12, b) == offs[1]; + int c = offsetof(C12, c) == offs[2]; + int d = offsetof(C12, d) == offs[3]; + return a && b && c && d; +} + +int checkFieldsC12(C12* s1, C12* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + int d = s1->d == s2->d; + return a && b && c && d; +} + +HsInt16 getSizeC12() { + return sizeof(C12); +} + +HsInt16 getAlignmentC12() { + return alignof(C12); +} + +typedef struct C13{ + C12 a; + C12 b; + C12 c; + C12 d; +} C13; + +C13 * newC13(C12* a, C12* b, C12* c, C12* d){ + C13 * ret = (C13*) malloc(sizeof(C13)); + ret->a = *a; + ret->b = *b; + ret->c = *c; + ret->d = *d; + return ret; +} + +void pokeC13(C13* val, C12* a, C12* b, C12* c, C12* d){ + val->a = *a; + val->b = *b; + val->c = *c; + val->d = *d; +} + +int checkOffsetsC13(HsInt16 *offs){ + int a = offsetof(C13, a) == offs[0]; + 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 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 d = checkFieldsC12(&(s1->d),&(s2->d)); + return a && b && c && d; +} + +HsInt16 getSizeC13() { + return sizeof(C13); +} + +HsInt16 getAlignmentC13() { + return alignof(C13); +} + +typedef struct C14{ + C13 a; + C13 b; + C13 c; + C13 d; + HsInt8 e; +} C14; + +C14 * newC14(C13* a, C13* b, C13* c, C13* d, HsInt8 e){ + C14 * ret = (C14*) malloc(sizeof(C14)); + ret->a = *a; + ret->b = *b; + ret->c = *c; + ret->d = *d; + ret->e = e; + return ret; +} + +void pokeC14(C14* val, C13* a, C13* b, C13* c, C13* d, HsInt8 e){ + val->a = *a; + val->b = *b; + val->c = *c; + val->d = *d; + val->e = e; +} + +int checkOffsetsC14(HsInt16 *offs){ + int a = offsetof(C14, a) == offs[0]; + int b = offsetof(C14, b) == offs[1]; + int c = offsetof(C14, c) == offs[2]; + int d = offsetof(C14, d) == offs[3]; + int e = offsetof(C14, e) == offs[4]; + return a && b && c && d && e; +} + +int checkFieldsC14(C14* s1, C14* s2){ + int a = checkFieldsC13(&(s1->a),&(s2->a)); + int b = checkFieldsC13(&(s1->b),&(s2->b)); + int c = checkFieldsC13(&(s1->c),&(s2->c)); + int d = checkFieldsC13(&(s1->d),&(s2->d)); + int e = s1->e == s2->e; + return a && b && c && d && e; +} + +HsInt16 getSizeC14() { + return sizeof(C14); +} + +HsInt16 getAlignmentC14() { + return alignof(C14); +} + +typedef struct C15{ + C12 a; + C14 b; +} C15; + +C15 * newC15(C12* a, C14* b){ + C15 * ret = (C15*) malloc(sizeof(C15)); + ret->a = *a; + ret->b = *b; + return ret; +} + +void pokeC15(C15* val, C12* a, C14* b){ + val->a = *a; + val->b = *b; +} + +int checkOffsetsC15(HsInt16 *offs){ + int a = offsetof(C15, a) == offs[0]; + int b = offsetof(C15, b) == offs[1]; + return a && b; +} + +int checkFieldsC15(C15* s1, C15* s2){ + int a = checkFieldsC12(&(s1->a),&(s2->a)); + int b = checkFieldsC14(&(s1->b),&(s2->b)); + return a && b; +} + +HsInt16 getSizeC15() { + return sizeof(C15); +} + +HsInt16 getAlignmentC15() { + return alignof(C15); +} + +typedef struct C16{ + C10 a; + C15 b; + C7 c; +} C16; + +C16 * newC16(C10* a, C15* b, C7* c){ + C16 * ret = (C16*) malloc(sizeof(C16)); + ret->a = *a; + ret->b = *b; + ret->c = *c; + return ret; +} + +void pokeC16(C16* val, C10* a, C15* b, C7* c){ + val->a = *a; + val->b = *b; + val->c = *c; +} + +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 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; +} + +HsInt16 getSizeC16() { + return sizeof(C16); +} + +HsInt16 getAlignmentC16() { + return alignof(C16); +} + +typedef struct C17{ + HsFloat a; + HsDouble b; + HsFloat c; +} C17; + +C17 * newC17(HsFloat a, HsDouble b, HsFloat c){ + C17 * ret = (C17*) malloc(sizeof(C17)); + ret->a = a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC17(C17* val, HsFloat a, HsDouble b, HsFloat c){ + val->a = a; + val->b = b; + val->c = c; +} + +int checkOffsetsC17(HsInt16 *offs){ + int a = offsetof(C17, a) == offs[0]; + int b = offsetof(C17, b) == offs[1]; + int c = offsetof(C17, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC17(C17* s1, C17* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC17() { + return sizeof(C17); +} + +HsInt16 getAlignmentC17() { + return alignof(C17); +} + +typedef struct C18{ + HsFloat a; + HsFloat b; + HsDouble c; + HsFloat d; +} C18; + +C18 * newC18(HsFloat a, HsFloat b, HsDouble c, HsFloat d){ + C18 * ret = (C18*) malloc(sizeof(C18)); + ret->a = a; + ret->b = b; + ret->c = c; + ret->d = d; + return ret; +} + +void pokeC18(C18* val, HsFloat a, HsFloat b, HsDouble c, HsFloat d){ + val->a = a; + val->b = b; + val->c = c; + val->d = d; +} + +int checkOffsetsC18(HsInt16 *offs){ + int a = offsetof(C18, a) == offs[0]; + int b = offsetof(C18, b) == offs[1]; + int c = offsetof(C18, c) == offs[2]; + int d = offsetof(C18, d) == offs[3]; + return a && b && c && d; +} + +int checkFieldsC18(C18* s1, C18* s2){ + int a = s1->a == s2->a; + int b = s1->b == s2->b; + int c = s1->c == s2->c; + int d = s1->d == s2->d; + return a && b && c && d; +} + +HsInt16 getSizeC18() { + return sizeof(C18); +} + +HsInt16 getAlignmentC18() { + return alignof(C18); +} + +typedef struct C19{ + C17 a; + HsFloat b; + HsDouble c; +} C19; + +C19 * newC19(C17* a, HsFloat b, HsDouble c){ + C19 * ret = (C19*) malloc(sizeof(C19)); + ret->a = *a; + ret->b = b; + ret->c = c; + return ret; +} + +void pokeC19(C19* val, C17* a, HsFloat b, HsDouble c){ + val->a = *a; + val->b = b; + val->c = c; +} + +int checkOffsetsC19(HsInt16 *offs){ + int a = offsetof(C19, a) == offs[0]; + int b = offsetof(C19, b) == offs[1]; + int c = offsetof(C19, c) == offs[2]; + return a && b && c; +} + +int checkFieldsC19(C19* s1, C19* s2){ + int a = checkFieldsC17(&(s1->a),&(s2->a)); + int b = s1->b == s2->b; + int c = s1->c == s2->c; + return a && b && c; +} + +HsInt16 getSizeC19() { + return sizeof(C19); +} + +HsInt16 getAlignmentC19() { + return alignof(C19); +} + +typedef struct C20{ + HsDouble a; + C18 b; + HsDouble c; + C19 d; +} C20; + +C20 * newC20(HsDouble a, C18* b, HsDouble c, C19* d){ + C20 * ret = (C20*) malloc(sizeof(C20)); + ret->a = a; + ret->b = *b; + ret->c = c; + ret->d = *d; + return ret; +} + +void pokeC20(C20* val, HsDouble a, C18* b, HsDouble c, C19* d){ + val->a = a; + val->b = *b; + val->c = c; + val->d = *d; +} + +int checkOffsetsC20(HsInt16 *offs){ + int a = offsetof(C20, a) == offs[0]; + int b = offsetof(C20, b) == offs[1]; + int c = offsetof(C20, c) == offs[2]; + int d = offsetof(C20, d) == offs[3]; + return a && b && c && d; +} + +int checkFieldsC20(C20* s1, C20* s2){ + int a = s1->a == s2->a; + int b = checkFieldsC18(&(s1->b),&(s2->b)); + int c = s1->c == s2->c; + int d = checkFieldsC19(&(s1->d),&(s2->d)); + return a && b && c && d; +} + +HsInt16 getSizeC20() { + return sizeof(C20); +} + +HsInt16 getAlignmentC20() { + return alignof(C20); +} + diff --git a/test/Spec/Spec.hs b/test/Spec/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}