[GHC] #15531: CApiFFI generates bad prototypes for pointers of `Foreign.C` types
GHC
ghc-devs at haskell.org
Fri Aug 17 11:35:20 UTC 2018
#15531: CApiFFI generates bad prototypes for pointers of `Foreign.C` types
-------------------------------------+-------------------------------------
Reporter: hvr | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone: 8.6.1
Component: Compiler | Version: 8.4.3
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by hvr:
Old description:
> Consider the example
>
> {{{#!hs
> {-# LANGUAGE CApiFFI #-}
>
> module Foo where
>
> import Foreign.Ptr
> import Foreign.C
>
> foreign import capi unsafe "foo.h fn1" c_fn1 :: Char -> IO Char
>
> foreign import capi unsafe "foo.h fn2" c_fn2 :: Ptr Char -> IO (Ptr Char)
>
> foreign import capi unsafe "foo.h fn3" c_fn3 :: Ptr (Ptr Char) -> IO (Ptr
> (Ptr Char))
>
> foreign import capi unsafe "foo.h fn4" c_fn4 :: CChar -> IO CChar
>
> foreign import capi unsafe "foo.h fn5" c_fn5 :: Ptr CChar -> IO (Ptr
> CChar)
>
> foreign import capi unsafe "foo.h fn6" c_fn6 :: Ptr (Ptr CChar) -> IO
> (Ptr (Ptr CChar))
>
> foreign import capi unsafe "foo.h fn7" c_fn7 :: CUChar -> CSChar ->
> CShort -> CUShort -> CInt -> CUInt -> CLong -> CULong -> CSize -> IO ()
>
> foreign import capi unsafe "foo.h fn8" c_fn8 :: Ptr CUChar -> Ptr CSChar
> -> Ptr CShort -> Ptr CUShort -> Ptr CInt -> Ptr CUInt -> Ptr CLong -> Ptr
> CULong -> Ptr CSize -> IO ()
> }}}
>
> which creates various wrappers; this generates the C wrapper
>
> {{{#!c
>
> #define IN_STG_CODE 0
> #include "Rts.h"
> #include "Stg.h"
> #ifdef __cplusplus
> extern "C" {
> #endif
> #include "foo.h"
> void ghczuwrapperZC0ZCmainZCFooZCfn8(void* a1, void* a2, void* a3, void*
> a4, void* a5, void* a6, void* a7, void* a8, void* a9) {fn8(a1, a2, a3,
> a4, a5, a6, a7, a8, a9);}
> #include "foo.h"
> void ghczuwrapperZC1ZCmainZCFooZCfn7(HsWord8 a1, HsInt8 a2, HsInt16 a3,
> HsWord16 a4, HsInt32 a5, HsWord32 a6, HsInt64 a7, HsWord64 a8, HsWord64
> a9) {fn7(a1, a2, a3, a4, a5, a6, a7, a8, a9);}
> #include "foo.h"
> void** ghczuwrapperZC2ZCmainZCFooZCfn6(void** a1) {return fn6(a1);}
> #include "foo.h"
> void* ghczuwrapperZC3ZCmainZCFooZCfn5(void* a1) {return fn5(a1);}
> #include "foo.h"
> HsInt8 ghczuwrapperZC4ZCmainZCFooZCfn4(HsInt8 a1) {return fn4(a1);}
> #include "foo.h"
> HsChar** ghczuwrapperZC5ZCmainZCFooZCfn3(HsChar** a1) {return fn3(a1);}
> #include "foo.h"
> HsChar* ghczuwrapperZC6ZCmainZCFooZCfn2(HsChar* a1) {return fn2(a1);}
> #include "foo.h"
> HsChar ghczuwrapperZC7ZCmainZCFooZCfn1(HsChar a1) {return fn1(a1);}
> #ifdef __cplusplus
> }
> #endif
>
> }}}
>
> Specifically, the wrappers for `c_fn4`, `c_fn5` and `c_fn8` are wrong.
>
> This is quite a serious bug as it renders `CApiFFI` unusable for matching
> with C prototypes, as modern C compilers will refuse to coerce a pointer
> `void**` into an argument to a function expecting a `char**`. One
> concrete example is e.g.
>
> {{{#!hs
> -- int getfilecon(const char *path, char **con);
> foreign import capi safe "selinux/selinux.h getfilecon" c_getfilecon' ::
> CString -> Ptr CString -> IO CInt
>
> }}}
>
> which even though properly declared (NB: `type CString = Ptr CChar`),
> when compiled would fail because of this bug:
>
> {{{
> tmpdir/ghc31009_0/ghc_2.c: In function
> ‘ghczuwrapperZC0ZCmainZCBarZCgetfilecon’:
>
> tmpdir/ghc31009_0/ghc_2.c:8:92: error:
> warning: passing argument 2 of ‘getfilecon’ from incompatible
> pointer type [-Wincompatible-pointer-types]
> HsInt32 ghczuwrapperZC0ZCmainZCBarZCgetfilecon(void* a1, void** a2)
> {return getfilecon(a1, a2);}
> ^
> |
> 8 | HsInt32 ghczuwrapperZC0ZCmainZCBarZCgetfilecon(void* a1, void** a2)
> {return getfilecon(a1, a2);}
> |
> ^
>
> In file included from tmpdir/ghc31009_0/ghc_2.c:7:0: error:
>
> /usr/include/selinux/selinux.h:101:12: error:
> note: expected ‘char **’ but argument is of type ‘void **’
> extern int getfilecon(const char *path, char ** con);
> ^
> |
> 101 | extern int getfilecon(const char *path, char ** con);
> | ^
> }}}
New description:
Consider the example
{{{#!hs
{-# LANGUAGE CApiFFI #-}
module Foo where
import Foreign.Ptr
import Foreign.C
foreign import capi unsafe "foo.h fn1" c_fn1 :: Char -> IO Char
foreign import capi unsafe "foo.h fn2" c_fn2 :: Ptr Char -> IO (Ptr Char)
foreign import capi unsafe "foo.h fn3" c_fn3 :: Ptr (Ptr Char) -> IO (Ptr
(Ptr Char))
foreign import capi unsafe "foo.h fn4" c_fn4 :: CChar -> IO CChar
foreign import capi unsafe "foo.h fn5" c_fn5 :: Ptr CChar -> IO (Ptr
CChar)
foreign import capi unsafe "foo.h fn6" c_fn6 :: Ptr (Ptr CChar) -> IO (Ptr
(Ptr CChar))
foreign import capi unsafe "foo.h fn7" c_fn7 :: CUChar -> CSChar -> CShort
-> CUShort -> CInt -> CUInt -> CLong -> CULong -> CSize -> IO ()
foreign import capi unsafe "foo.h fn8" c_fn8 :: Ptr CUChar -> Ptr CSChar
-> Ptr CShort -> Ptr CUShort -> Ptr CInt -> Ptr CUInt -> Ptr CLong -> Ptr
CULong -> Ptr CSize -> IO ()
}}}
which creates various wrappers; this generates the C wrapper
{{{#!c
#define IN_STG_CODE 0
#include "Rts.h"
#include "Stg.h"
#ifdef __cplusplus
extern "C" {
#endif
#include "foo.h"
void ghczuwrapperZC0ZCmainZCFooZCfn8(void* a1, void* a2, void* a3, void*
a4, void* a5, void* a6, void* a7, void* a8, void* a9) {fn8(a1, a2, a3, a4,
a5, a6, a7, a8, a9);}
#include "foo.h"
void ghczuwrapperZC1ZCmainZCFooZCfn7(HsWord8 a1, HsInt8 a2, HsInt16 a3,
HsWord16 a4, HsInt32 a5, HsWord32 a6, HsInt64 a7, HsWord64 a8, HsWord64
a9) {fn7(a1, a2, a3, a4, a5, a6, a7, a8, a9);}
#include "foo.h"
void** ghczuwrapperZC2ZCmainZCFooZCfn6(void** a1) {return fn6(a1);}
#include "foo.h"
void* ghczuwrapperZC3ZCmainZCFooZCfn5(void* a1) {return fn5(a1);}
#include "foo.h"
HsInt8 ghczuwrapperZC4ZCmainZCFooZCfn4(HsInt8 a1) {return fn4(a1);}
#include "foo.h"
HsChar** ghczuwrapperZC5ZCmainZCFooZCfn3(HsChar** a1) {return fn3(a1);}
#include "foo.h"
HsChar* ghczuwrapperZC6ZCmainZCFooZCfn2(HsChar* a1) {return fn2(a1);}
#include "foo.h"
HsChar ghczuwrapperZC7ZCmainZCFooZCfn1(HsChar a1) {return fn1(a1);}
#ifdef __cplusplus
}
#endif
}}}
Specifically, the wrappers for `c_fn5`, `c_fn6` and `c_fn8` are wrong.
This is quite a serious bug as it renders `CApiFFI` unusable for matching
with C prototypes, as modern C compilers will refuse to coerce a pointer
`void**` into an argument to a function expecting a `char**`. One concrete
example is e.g.
{{{#!hs
-- int getfilecon(const char *path, char **con);
foreign import capi safe "selinux/selinux.h getfilecon" c_getfilecon' ::
CString -> Ptr CString -> IO CInt
}}}
which even though properly declared (NB: `type CString = Ptr CChar`), when
compiled would fail because of this bug:
{{{
tmpdir/ghc31009_0/ghc_2.c: In function
‘ghczuwrapperZC0ZCmainZCBarZCgetfilecon’:
tmpdir/ghc31009_0/ghc_2.c:8:92: error:
warning: passing argument 2 of ‘getfilecon’ from incompatible pointer
type [-Wincompatible-pointer-types]
HsInt32 ghczuwrapperZC0ZCmainZCBarZCgetfilecon(void* a1, void** a2)
{return getfilecon(a1, a2);}
^
|
8 | HsInt32 ghczuwrapperZC0ZCmainZCBarZCgetfilecon(void* a1, void** a2)
{return getfilecon(a1, a2);}
|
^
In file included from tmpdir/ghc31009_0/ghc_2.c:7:0: error:
/usr/include/selinux/selinux.h:101:12: error:
note: expected ‘char **’ but argument is of type ‘void **’
extern int getfilecon(const char *path, char ** con);
^
|
101 | extern int getfilecon(const char *path, char ** con);
| ^
}}}
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15531#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list