diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-01-17 14:28:49 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-01-19 13:32:25 -0500 |
commit | 3b009e1a6247057ff976043695b797b5d0649414 (patch) | |
tree | c1a4b4ce17048e7c1fb751371e3feda146bb98ed | |
parent | 592e41131613e198560de3c88158eadcd789b317 (diff) | |
download | haskell-3b009e1a6247057ff976043695b797b5d0649414.tar.gz |
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.
-rw-r--r-- | libraries/base/Foreign/C/Types.hs | 52 | ||||
-rw-r--r-- | libraries/base/Foreign/Ptr.hs | 4 | ||||
-rw-r--r-- | libraries/base/System/Posix/Types.hs | 48 | ||||
-rw-r--r-- | libraries/base/include/CTypes.h | 21 | ||||
-rw-r--r-- | testsuite/tests/ffi/should_compile/T15531.h | 6 | ||||
-rw-r--r-- | testsuite/tests/ffi/should_compile/T15531.hs | 19 | ||||
-rw-r--r-- | testsuite/tests/ffi/should_compile/all.T | 1 |
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']) |