CApiFFI generates bad prototypes for pointers of `Foreign.C` types
Consider the example
{-# 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
#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.
-- 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);
| ^
Edited by Herbert Valerio Riedel