base: Add CTYPE pragmas to all foreign types

Fixes #15531 by ensuring that we know the corresponding C type for all
marshalling wrappers.

Closes #15531.

7 files changed, 87 insertions, 64 deletions

diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs
index 05295a819f..d2f3245b11 100644
--- a/libraries/base/Foreign/C/Types.hs
+++ b/libraries/base/Foreign/C/Types.hs
@@ -104,54 +104,54 @@ import GHC.Num
 
 -- | Haskell type representing the C @char@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CChar,HTYPE_CHAR)
+INTEGRAL_TYPE(CChar,"char",HTYPE_CHAR)
 -- | Haskell type representing the C @signed char@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CSChar,HTYPE_SIGNED_CHAR)
+INTEGRAL_TYPE(CSChar,"signed char",HTYPE_SIGNED_CHAR)
 -- | Haskell type representing the C @unsigned char@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CUChar,HTYPE_UNSIGNED_CHAR)
+INTEGRAL_TYPE(CUChar,"unsigned char",HTYPE_UNSIGNED_CHAR)
 
 -- | Haskell type representing the C @short@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CShort,HTYPE_SHORT)
+INTEGRAL_TYPE(CShort,"short",HTYPE_SHORT)
 -- | Haskell type representing the C @unsigned short@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CUShort,HTYPE_UNSIGNED_SHORT)
+INTEGRAL_TYPE(CUShort,"unsigned short",HTYPE_UNSIGNED_SHORT)
 
 -- | Haskell type representing the C @int@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CInt,HTYPE_INT)
+INTEGRAL_TYPE(CInt,"int",HTYPE_INT)
 -- | Haskell type representing the C @unsigned int@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CUInt,HTYPE_UNSIGNED_INT)
+INTEGRAL_TYPE(CUInt,"unsigned int",HTYPE_UNSIGNED_INT)
 
 -- | Haskell type representing the C @long@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CLong,HTYPE_LONG)
+INTEGRAL_TYPE(CLong,"long",HTYPE_LONG)
 -- | Haskell type representing the C @unsigned long@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CULong,HTYPE_UNSIGNED_LONG)
+INTEGRAL_TYPE(CULong,"unsigned long",HTYPE_UNSIGNED_LONG)
 
 -- | Haskell type representing the C @long long@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG)
+INTEGRAL_TYPE(CLLong,"long long",HTYPE_LONG_LONG)
 -- | Haskell type representing the C @unsigned long long@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG)
+INTEGRAL_TYPE(CULLong,"unsigned long long",HTYPE_UNSIGNED_LONG_LONG)
 
 -- | Haskell type representing the C @bool@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
 --
 -- @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CBool,bool,HTYPE_BOOL)
+INTEGRAL_TYPE(CBool,"bool",HTYPE_BOOL)
 
 -- | Haskell type representing the C @float@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-FLOATING_TYPE(CFloat,HTYPE_FLOAT)
+FLOATING_TYPE(CFloat,"float",HTYPE_FLOAT)
 -- | Haskell type representing the C @double@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-FLOATING_TYPE(CDouble,HTYPE_DOUBLE)
+FLOATING_TYPE(CDouble,"double",HTYPE_DOUBLE)
 -- XXX GHC doesn't support CLDouble yet
 
 {-# RULES
@@ -168,34 +168,34 @@ FLOATING_TYPE(CDouble,HTYPE_DOUBLE)
 
 -- | Haskell type representing the C @ptrdiff_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CPtrdiff,HTYPE_PTRDIFF_T)
+INTEGRAL_TYPE(CPtrdiff,"ptrdiff_t",HTYPE_PTRDIFF_T)
 -- | Haskell type representing the C @size_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CSize,HTYPE_SIZE_T)
+INTEGRAL_TYPE(CSize,"size_t",HTYPE_SIZE_T)
 -- | Haskell type representing the C @wchar_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CWchar,HTYPE_WCHAR_T)
+INTEGRAL_TYPE(CWchar,"wchar_t",HTYPE_WCHAR_T)
 -- | Haskell type representing the C @sig_atomic_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-INTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T)
+INTEGRAL_TYPE(CSigAtomic,"sig_atomic_t",HTYPE_SIG_ATOMIC_T)
 
 -- | Haskell type representing the C @clock_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-ARITHMETIC_TYPE(CClock,HTYPE_CLOCK_T)
+ARITHMETIC_TYPE(CClock,"clock_t",HTYPE_CLOCK_T)
 -- | Haskell type representing the C @time_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
-ARITHMETIC_TYPE(CTime,HTYPE_TIME_T)
+ARITHMETIC_TYPE(CTime,"time_t",HTYPE_TIME_T)
 -- | Haskell type representing the C @useconds_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
 --
 -- @since 4.4.0.0
 
-ARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T)
+ARITHMETIC_TYPE(CUSeconds,"useconds_t",HTYPE_USECONDS_T)
 -- | Haskell type representing the C @suseconds_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
 --
 -- @since 4.4.0.0
-ARITHMETIC_TYPE(CSUSeconds,HTYPE_SUSECONDS_T)
+ARITHMETIC_TYPE(CSUSeconds,"suseconds_t",HTYPE_SUSECONDS_T)
 
 -- FIXME: Implement and provide instances for Eq and Storable
 -- | Haskell type representing the C @FILE@ type.
@@ -208,10 +208,10 @@ data CFpos = CFpos
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
 data CJmpBuf = CJmpBuf
 
-INTEGRAL_TYPE(CIntPtr,HTYPE_INTPTR_T)
-INTEGRAL_TYPE(CUIntPtr,HTYPE_UINTPTR_T)
-INTEGRAL_TYPE(CIntMax,HTYPE_INTMAX_T)
-INTEGRAL_TYPE(CUIntMax,HTYPE_UINTMAX_T)
+INTEGRAL_TYPE(CIntPtr,"intptr_t",HTYPE_INTPTR_T)
+INTEGRAL_TYPE(CUIntPtr,"uintptr_t",HTYPE_UINTPTR_T)
+INTEGRAL_TYPE(CIntMax,"intmax_t",HTYPE_INTMAX_T)
+INTEGRAL_TYPE(CUIntMax,"uintmax_t",HTYPE_UINTMAX_T)
 
 -- C99 types which are still missing include:
 -- wint_t, wctrans_t, wctype_t
diff --git a/libraries/base/Foreign/Ptr.hs b/libraries/base/Foreign/Ptr.hs
index 6efe8908cf..2607448f2a 100644
--- a/libraries/base/Foreign/Ptr.hs
+++ b/libraries/base/Foreign/Ptr.hs
@@ -79,13 +79,13 @@ foreign import ccall unsafe "freeHaskellFunctionPtr"
 -- | An unsigned integral type that can be losslessly converted to and from
 -- @Ptr@. This type is also compatible with the C99 type @uintptr_t@, and
 -- can be marshalled to and from that type safely.
-INTEGRAL_TYPE(WordPtr,Word)
+INTEGRAL_TYPE(WordPtr,"uintptr_t",Word)
         -- Word and Int are guaranteed pointer-sized in GHC
 
 -- | A signed integral type that can be losslessly converted to and from
 -- @Ptr@.  This type is also compatible with the C99 type @intptr_t@, and
 -- can be marshalled to and from that type safely.
-INTEGRAL_TYPE(IntPtr,Int)
+INTEGRAL_TYPE(IntPtr,"intptr_t",Int)
         -- Word and Int are guaranteed pointer-sized in GHC
 
 -- | casts a @Ptr@ to a @WordPtr@
diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs
index 04db747eb7..d3654fef86 100644
--- a/libraries/base/System/Posix/Types.hs
+++ b/libraries/base/System/Posix/Types.hs
@@ -143,92 +143,92 @@ import GHC.Show
 #include "CTypes.h"
 
 #if defined(HTYPE_DEV_T)
-INTEGRAL_TYPE(CDev,HTYPE_DEV_T)
+INTEGRAL_TYPE(CDev,"dev_t",HTYPE_DEV_T)
 #endif
 #if defined(HTYPE_INO_T)
-INTEGRAL_TYPE(CIno,HTYPE_INO_T)
+INTEGRAL_TYPE(CIno,"ino_t",HTYPE_INO_T)
 #endif
 #if defined(HTYPE_MODE_T)
-INTEGRAL_TYPE_WITH_CTYPE(CMode,mode_t,HTYPE_MODE_T)
+INTEGRAL_TYPE(CMode,"mode_t",HTYPE_MODE_T)
 #endif
 #if defined(HTYPE_OFF_T)
-INTEGRAL_TYPE(COff,HTYPE_OFF_T)
+INTEGRAL_TYPE(COff,"off_t",HTYPE_OFF_T)
 #endif
 #if defined(HTYPE_PID_T)
-INTEGRAL_TYPE(CPid,HTYPE_PID_T)
+INTEGRAL_TYPE(CPid,"pid_t",HTYPE_PID_T)
 #endif
 
 #if defined(HTYPE_SSIZE_T)
-INTEGRAL_TYPE(CSsize,HTYPE_SSIZE_T)
+INTEGRAL_TYPE(CSsize,"ssize_t",HTYPE_SSIZE_T)
 #endif
 
 #if defined(HTYPE_GID_T)
-INTEGRAL_TYPE(CGid,HTYPE_GID_T)
+INTEGRAL_TYPE(CGid,"gid_t",HTYPE_GID_T)
 #endif
 #if defined(HTYPE_NLINK_T)
-INTEGRAL_TYPE(CNlink,HTYPE_NLINK_T)
+INTEGRAL_TYPE(CNlink,"nlink_t",HTYPE_NLINK_T)
 #endif
 
 #if defined(HTYPE_UID_T)
-INTEGRAL_TYPE(CUid,HTYPE_UID_T)
+INTEGRAL_TYPE(CUid,"uid_t",HTYPE_UID_T)
 #endif
 #if defined(HTYPE_CC_T)
-ARITHMETIC_TYPE(CCc,HTYPE_CC_T)
+ARITHMETIC_TYPE(CCc,"cc_t",HTYPE_CC_T)
 #endif
 #if defined(HTYPE_SPEED_T)
-ARITHMETIC_TYPE(CSpeed,HTYPE_SPEED_T)
+ARITHMETIC_TYPE(CSpeed,"speed_t",HTYPE_SPEED_T)
 #endif
 #if defined(HTYPE_TCFLAG_T)
-INTEGRAL_TYPE(CTcflag,HTYPE_TCFLAG_T)
+INTEGRAL_TYPE(CTcflag,"tcflag_t",HTYPE_TCFLAG_T)
 #endif
 #if defined(HTYPE_RLIM_T)
-INTEGRAL_TYPE(CRLim,HTYPE_RLIM_T)
+INTEGRAL_TYPE(CRLim,"rlim_t",HTYPE_RLIM_T)
 #endif
 
 #if defined(HTYPE_BLKSIZE_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CBlkSize,blksize_t,HTYPE_BLKSIZE_T)
+INTEGRAL_TYPE(CBlkSize,"blksize_t",HTYPE_BLKSIZE_T)
 #endif
 #if defined(HTYPE_BLKCNT_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CBlkCnt,blkcnt_t,HTYPE_BLKCNT_T)
+INTEGRAL_TYPE(CBlkCnt,"blkcnt_t",HTYPE_BLKCNT_T)
 #endif
 #if defined(HTYPE_CLOCKID_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CClockId,clockid_t,HTYPE_CLOCKID_T)
+INTEGRAL_TYPE(CClockId,"clockid_t",HTYPE_CLOCKID_T)
 #endif
 #if defined(HTYPE_FSBLKCNT_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CFsBlkCnt,fsblkcnt_t,HTYPE_FSBLKCNT_T)
+INTEGRAL_TYPE(CFsBlkCnt,"fsblkcnt_t",HTYPE_FSBLKCNT_T)
 #endif
 #if defined(HTYPE_FSFILCNT_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CFsFilCnt,fsfilcnt_t,HTYPE_FSFILCNT_T)
+INTEGRAL_TYPE(CFsFilCnt,"fsfilcnt_t",HTYPE_FSFILCNT_T)
 #endif
 #if defined(HTYPE_ID_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CId,id_t,HTYPE_ID_T)
+INTEGRAL_TYPE(CId,"id_t",HTYPE_ID_T)
 #endif
 #if defined(HTYPE_KEY_T)
 -- | @since 4.10.0.0
-INTEGRAL_TYPE_WITH_CTYPE(CKey,key_t,HTYPE_KEY_T)
+INTEGRAL_TYPE(CKey,"key_t",HTYPE_KEY_T)
 #endif
 #if defined(HTYPE_TIMER_T)
 -- | @since 4.10.0.0
-OPAQUE_TYPE_WITH_CTYPE(CTimer,timer_t,HTYPE_TIMER_T)
+OPAQUE_TYPE(CTimer,"timer_t",HTYPE_TIMER_T)
 #endif
 
 #if defined(HTYPE_SOCKLEN_T)
 -- | @since 4.14.0.0
-INTEGRAL_TYPE(CSocklen,HTYPE_SOCKLEN_T)
+INTEGRAL_TYPE(CSocklen,"socklen_t",HTYPE_SOCKLEN_T)
 #endif
 #if defined(HTYPE_NFDS_T)
 -- | @since 4.14.0.0
-INTEGRAL_TYPE(CNfds,HTYPE_NFDS_T)
+INTEGRAL_TYPE(CNfds,"nfds_t",HTYPE_NFDS_T)
 #endif
 
 -- Make an Fd type rather than using CInt everywhere
-INTEGRAL_TYPE(Fd,CInt)
+INTEGRAL_TYPE(Fd,"int",CInt)
 
 -- nicer names, and backwards compatibility with POSIX library:
 #if defined(HTYPE_NLINK_T)
diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h
index 13ab70ada3..7bb3dbdc73 100644
--- a/libraries/base/include/CTypes.h
+++ b/libraries/base/include/CTypes.h
@@ -20,23 +20,20 @@
 #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat
 #define OPAQUE_CLASSES Eq,Ord,Storable
 
-#define ARITHMETIC_TYPE(T,B) \
-newtype T = T B deriving newtype (Read, Show, ARITHMETIC_CLASSES);
+#define ARITHMETIC_TYPE(T,THE_CTYPE,B) \
+newtype {-# CTYPE THE_CTYPE #-} T = T B deriving newtype (Read, Show, ARITHMETIC_CLASSES);
 
-#define INTEGRAL_TYPE(T,B) \
-newtype T = T B deriving newtype (Read, Show, ARITHMETIC_CLASSES, INTEGRAL_CLASSES);
-
-#define INTEGRAL_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \
-newtype {-# CTYPE "THE_CTYPE" #-} T = T B \
+#define INTEGRAL_TYPE(T,THE_CTYPE,B) \
+newtype {-# CTYPE THE_CTYPE #-} T = T B \
     deriving newtype (Read, Show, ARITHMETIC_CLASSES, INTEGRAL_CLASSES);
 
-#define FLOATING_TYPE(T,B) \
-newtype T = T B deriving newtype (Read, Show, ARITHMETIC_CLASSES, FLOATING_CLASSES);
+#define FLOATING_TYPE(T,THE_CTYPE,B) \
+newtype {-# CTYPE THE_CTYPE #-} T = T B deriving newtype (Read, Show, ARITHMETIC_CLASSES, FLOATING_CLASSES);
 
 #define FLOATING_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \
-newtype {-# CTYPE "THE_CTYPE" #-} T = T B \
+newtype {-# CTYPE THE_CTYPE #-} T = T B \
     deriving newtype (Read, Show, ARITHMETIC_CLASSES, FLOATING_CLASSES);
 
-#define OPAQUE_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \
-newtype {-# CTYPE "THE_CTYPE" #-} T = T (B) \
+#define OPAQUE_TYPE(T,THE_CTYPE,B) \
+newtype {-# CTYPE THE_CTYPE #-} T = T (B) \
     deriving newtype (Show, OPAQUE_CLASSES);
diff --git a/testsuite/tests/ffi/should_compile/T15531.h b/testsuite/tests/ffi/should_compile/T15531.h
new file mode 100644
index 0000000000..c1df3bff96
--- /dev/null
+++ b/testsuite/tests/ffi/should_compile/T15531.h
@@ -0,0 +1,6 @@
+char **fn3(char **x);
+char fn4(char x);
+char *fn5(char *x);
+char **fn6(char **x);
+void fn7(unsigned char a, signed char b, short c, unsigned short d, int e, unsigned int f, long g, unsigned long h, size_t i);
+void fn8(unsigned char *a, signed char *b, short *c, unsigned short *d, int *e, unsigned int *f, long *g, unsigned long *h, size_t *i);
diff --git a/testsuite/tests/ffi/should_compile/T15531.hs b/testsuite/tests/ffi/should_compile/T15531.hs
new file mode 100644
index 0000000000..b8f66825ce
--- /dev/null
+++ b/testsuite/tests/ffi/should_compile/T15531.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE CApiFFI #-}
+
+module Foo where
+
+import Foreign.Ptr
+import Foreign.C
+
+foreign import capi unsafe "T15531.h fn4" c_fn4 :: CChar -> IO CChar
+
+foreign import capi unsafe "T15531.h fn5" c_fn5 :: Ptr CChar -> IO (Ptr CChar)
+
+foreign import capi unsafe "T15531.h fn6" c_fn6 :: Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
+
+
+foreign import capi unsafe "T15531.h fn7" c_fn7 :: CUChar -> CSChar -> CShort -> CUShort -> CInt -> CUInt -> CLong -> CULong -> CSize -> IO ()
+
+
+foreign import capi unsafe "T15531.h fn8" c_fn8 :: Ptr CUChar -> Ptr CSChar -> Ptr CShort -> Ptr CUShort -> Ptr CInt -> Ptr CUInt -> Ptr CLong -> Ptr CULong -> Ptr CSize -> IO ()
+
diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T
index 69c5a38047..cf7f9502e9 100644
--- a/testsuite/tests/ffi/should_compile/all.T
+++ b/testsuite/tests/ffi/should_compile/all.T
@@ -43,3 +43,4 @@ test(
         + (' -optcxx=-stdlib=libc++' if opsys('darwin') else '')
     ],
 )
+test('T15531', normal, compile, ['-Wall'])