[GHC] #15531: CApiFFI generates bad prototypes for pointers of `Foreign.C` types

[GHC]

#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
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 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);
     |            ^
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15531>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler