diff --git a/hs-bindgen/examples/weird01.h b/hs-bindgen/examples/weird01.h new file mode 100644 index 00000000..543021b8 --- /dev/null +++ b/hs-bindgen/examples/weird01.h @@ -0,0 +1,8 @@ +struct foo { + int z; + struct bar { + int x; + }; +}; + +void func(struct bar* arg); diff --git a/hs-bindgen/fixtures/weird01.h.rs b/hs-bindgen/fixtures/weird01.h.rs new file mode 100644 index 00000000..e69de29b diff --git a/hs-bindgen/fixtures/weird01.hs b/hs-bindgen/fixtures/weird01.hs new file mode 100644 index 00000000..a0103fba --- /dev/null +++ b/hs-bindgen/fixtures/weird01.hs @@ -0,0 +1,413 @@ +[ + DeclForeignImport + ForeignImportDecl { + foreignImportName = HsName + "@NsVar" + "func", + foreignImportType = HsFun + (HsPtr + (HsTypRef + (HsName "@NsTypeConstr" "Bar"))) + (HsIO (HsPrimType HsPrimVoid)), + foreignImportOrigName = "func", + foreignImportHeader = + "weird01.h", + foreignImportDeclOrigin = + ForeignImportDeclOriginFunction + Function { + functionName = CName "func", + functionType = TypeFun + [ + TypePointer + (TypeStruct + (DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop))] + (TypePrim PrimVoid), + functionHeader = "weird01.h", + functionSourceLoc = + "examples/weird01.h:8:6"}}, + DeclData + Struct { + structName = HsName + "@NsTypeConstr" + "Foo", + structConstr = HsName + "@NsConstr" + "Foo", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "foo_z", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "foo")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:1:8"}}, + DeclInstance + (InstanceStorable + Struct { + structName = HsName + "@NsTypeConstr" + "Foo", + structConstr = HsName + "@NsConstr" + "Foo", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "foo_z", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "foo")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:1:8"}} + StorableInstance { + storableSizeOf = 4, + storableAlignment = 4, + storablePeek = Lambda + (NameHint "ptr") + (Ap + (StructCon + Struct { + structName = HsName + "@NsTypeConstr" + "Foo", + structConstr = HsName + "@NsConstr" + "Foo", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "foo_z", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "foo")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:1:8"}}) + [PeekByteOff (Idx 0) 0]), + storablePoke = Lambda + (NameHint "ptr") + (Lambda + (NameHint "s") + (ElimStruct + (Idx 0) + Struct { + structName = HsName + "@NsTypeConstr" + "Foo", + structConstr = HsName + "@NsConstr" + "Foo", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "foo_z", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "foo")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:1:8"}} + (Add 1) + (Seq + [ + PokeByteOff + (Idx 2) + 0 + (Idx 0)])))}), + DeclData + Struct { + structName = HsName + "@NsTypeConstr" + "Bar", + structConstr = HsName + "@NsConstr" + "Bar", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "bar_x", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:3:16"}}, + DeclInstance + (InstanceStorable + Struct { + structName = HsName + "@NsTypeConstr" + "Bar", + structConstr = HsName + "@NsConstr" + "Bar", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "bar_x", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:3:16"}} + StorableInstance { + storableSizeOf = 4, + storableAlignment = 4, + storablePeek = Lambda + (NameHint "ptr") + (Ap + (StructCon + Struct { + structName = HsName + "@NsTypeConstr" + "Bar", + structConstr = HsName + "@NsConstr" + "Bar", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "bar_x", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:3:16"}}) + [PeekByteOff (Idx 0) 0]), + storablePoke = Lambda + (NameHint "ptr") + (Lambda + (NameHint "s") + (ElimStruct + (Idx 0) + Struct { + structName = HsName + "@NsTypeConstr" + "Bar", + structConstr = HsName + "@NsConstr" + "Bar", + structFields = [ + Field { + fieldName = HsName + "@NsVar" + "bar_x", + fieldType = HsPrimType + HsPrimCInt, + fieldOrigin = + FieldOriginStructField + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}}], + structOrigin = + StructOriginStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:3:16"}} + (Add 1) + (Seq + [ + PokeByteOff + (Idx 2) + 0 + (Idx 0)])))})] diff --git a/hs-bindgen/fixtures/weird01.pp.hs b/hs-bindgen/fixtures/weird01.pp.hs new file mode 100644 index 00000000..a52b4961 --- /dev/null +++ b/hs-bindgen/fixtures/weird01.pp.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Example where + +import Data.Void (Void) +import qualified Foreign as F +import qualified Foreign.C as FC +import Prelude ((<*>), IO, pure) + +foreign import capi safe "weird01.h func" func :: (F.Ptr Bar) -> IO Void + +data Foo = Foo + { foo_z :: FC.CInt + } + +instance F.Storable Foo where + + sizeOf = \_ -> 4 + + alignment = \_ -> 4 + + peek = + \ptr0 -> + pure Foo + <*> F.peekByteOff ptr0 0 + + poke = + \ptr0 -> + \s1 -> + case s1 of + Foo foo_z2 -> F.pokeByteOff ptr0 0 foo_z2 + +data Bar = Bar + { bar_x :: FC.CInt + } + +instance F.Storable Bar where + + sizeOf = \_ -> 4 + + alignment = \_ -> 4 + + peek = + \ptr0 -> + pure Bar + <*> F.peekByteOff ptr0 0 + + poke = + \ptr0 -> + \s1 -> + case s1 of + Bar bar_x2 -> F.pokeByteOff ptr0 0 bar_x2 diff --git a/hs-bindgen/fixtures/weird01.rs b/hs-bindgen/fixtures/weird01.rs new file mode 100644 index 00000000..496a74ee --- /dev/null +++ b/hs-bindgen/fixtures/weird01.rs @@ -0,0 +1,27 @@ +/* automatically generated by rust-bindgen 0.70.1 */ + +#[repr(C)] +#[derive(Debug, Copy, Clone)] +pub struct foo { + pub z: ::std::os::raw::c_int, +} +#[repr(C)] +#[derive(Debug, Copy, Clone)] +pub struct foo_bar { + pub x: ::std::os::raw::c_int, +} +#[allow(clippy::unnecessary_operation, clippy::identity_op)] +const _: () = { + ["Size of foo_bar"][::std::mem::size_of::() - 4usize]; + ["Alignment of foo_bar"][::std::mem::align_of::() - 4usize]; + ["Offset of field: foo_bar::x"][::std::mem::offset_of!(foo_bar, x) - 0usize]; +}; +#[allow(clippy::unnecessary_operation, clippy::identity_op)] +const _: () = { + ["Size of foo"][::std::mem::size_of::() - 4usize]; + ["Alignment of foo"][::std::mem::align_of::() - 4usize]; + ["Offset of field: foo::z"][::std::mem::offset_of!(foo, z) - 0usize]; +}; +extern "C" { + pub fn func(arg: *mut foo_bar); +} diff --git a/hs-bindgen/fixtures/weird01.th.txt b/hs-bindgen/fixtures/weird01.th.txt new file mode 100644 index 00000000..2dff7237 --- /dev/null +++ b/hs-bindgen/fixtures/weird01.th.txt @@ -0,0 +1,16 @@ +foreign import capi safe "weird01.h func" func :: Ptr Bar -> + IO Void +data Foo = Foo {foo_z :: CInt} +instance Storable Foo + where {sizeOf = \_ -> 4; + alignment = \_ -> 4; + peek = \ptr_0 -> pure Foo <*> peekByteOff ptr_0 0; + poke = \ptr_1 -> \s_2 -> case s_2 of + {Foo foo_z_3 -> pokeByteOff ptr_1 0 foo_z_3}} +data Bar = Bar {bar_x :: CInt} +instance Storable Bar + where {sizeOf = \_ -> 4; + alignment = \_ -> 4; + peek = \ptr_0 -> pure Bar <*> peekByteOff ptr_0 0; + poke = \ptr_1 -> \s_2 -> case s_2 of + {Bar bar_x_3 -> pokeByteOff ptr_1 0 bar_x_3}} diff --git a/hs-bindgen/fixtures/weird01.tree-diff.txt b/hs-bindgen/fixtures/weird01.tree-diff.txt new file mode 100644 index 00000000..af298db2 --- /dev/null +++ b/hs-bindgen/fixtures/weird01.tree-diff.txt @@ -0,0 +1,53 @@ +WrapCHeader + (Header + [ + DeclFunction + Function { + functionName = CName "func", + functionType = TypeFun + [ + TypePointer + (TypeStruct + (DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop))] + (TypePrim PrimVoid), + functionHeader = "weird01.h", + functionSourceLoc = + "examples/weird01.h:8:6"}, + DeclStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "foo")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "z", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:2:13"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:1:8"}, + DeclStruct + Struct { + structDeclPath = DeclPathStruct + (DeclNameTag (CName "bar")) + DeclPathTop, + structSizeof = 4, + structAlignment = 4, + structFields = [ + StructField { + fieldName = CName "x", + fieldOffset = 0, + fieldType = TypePrim + (PrimIntegral (PrimInt Signed)), + fieldSourceLoc = + "examples/weird01.h:4:21"}], + structFlam = Nothing, + structSourceLoc = + "examples/weird01.h:3:16"}]) diff --git a/hs-bindgen/tests/golden.hs b/hs-bindgen/tests/golden.hs index 860b4ae6..da63633c 100644 --- a/hs-bindgen/tests/golden.hs +++ b/hs-bindgen/tests/golden.hs @@ -59,6 +59,7 @@ main' packageRoot bg = testGroup "golden" , golden "bool" , golden "anonymous" , golden "simple_func" + , golden "weird01" ] where golden name = testGroup name