Skip to content
Snippets Groups Projects
Commit 731f7ddd authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel :man_dancing:
Browse files

Add CTYPE annotations to ptr types used for FFI

This avoids incompatible-pointer warnings from the c-compiler when using
`CApiFFI`
parent 03783d27
No related branches found
No related tags found
No related merge requests found
...@@ -39,8 +39,8 @@ import Foreign.C ...@@ -39,8 +39,8 @@ import Foreign.C
newtype DirStream = DirStream (Ptr CDir) newtype DirStream = DirStream (Ptr CDir)
type CDir = () data {-# CTYPE "DIR" #-} CDir
type CDirent = () data {-# CTYPE "struct dirent" #-} CDirent
-- | @rewindDirStream dp@ calls @rewinddir@ to reposition -- | @rewindDirStream dp@ calls @rewinddir@ to reposition
-- the directory stream @dp@ at the beginning of the directory. -- the directory stream @dp@ at the beginning of the directory.
......
...@@ -320,9 +320,7 @@ getLock (Fd fd) lock = ...@@ -320,9 +320,7 @@ getLock (Fd fd) lock =
maybeResult (_, (Unlock, _, _, _)) = Nothing maybeResult (_, (Unlock, _, _, _)) = Nothing
maybeResult x = Just x maybeResult x = Just x
type CFLock = () allocaLock :: FileLock -> (Ptr Base.CFLock -> IO a) -> IO a
allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock (lockreq, mode, start, len) io = allocaLock (lockreq, mode, start, len) io =
allocaBytes (#const sizeof(struct flock)) $ \p -> do allocaBytes (#const sizeof(struct flock)) $ \p -> do
(#poke struct flock, l_type) p (lockReq2Int lockreq :: CShort) (#poke struct flock, l_type) p (lockReq2Int lockreq :: CShort)
...@@ -336,7 +334,7 @@ lockReq2Int ReadLock = (#const F_RDLCK) ...@@ -336,7 +334,7 @@ lockReq2Int ReadLock = (#const F_RDLCK)
lockReq2Int WriteLock = (#const F_WRLCK) lockReq2Int WriteLock = (#const F_WRLCK)
lockReq2Int Unlock = (#const F_UNLCK) lockReq2Int Unlock = (#const F_UNLCK)
bytes2ProcessIDAndLock :: Ptr CFLock -> IO (ProcessID, FileLock) bytes2ProcessIDAndLock :: Ptr Base.CFLock -> IO (ProcessID, FileLock)
bytes2ProcessIDAndLock p = do bytes2ProcessIDAndLock p = do
req <- (#peek struct flock, l_type) p req <- (#peek struct flock, l_type) p
mode <- (#peek struct flock, l_whence) p mode <- (#peek struct flock, l_whence) p
......
...@@ -212,7 +212,7 @@ getProcessTimes = do ...@@ -212,7 +212,7 @@ getProcessTimes = do
childSystemTime = cst childSystemTime = cst
}) })
type CTms = () data {-# CTYPE "struct tms" #-} CTms
foreign import capi unsafe "HsUnix.h times" foreign import capi unsafe "HsUnix.h times"
c_times :: Ptr CTms -> IO CClock c_times :: Ptr CTms -> IO CClock
......
...@@ -55,7 +55,7 @@ data ResourceLimit ...@@ -55,7 +55,7 @@ data ResourceLimit
| ResourceLimit Integer | ResourceLimit Integer
deriving Eq deriving Eq
type RLimit = () data {-# CTYPE "struct rlimit" #-} RLimit
foreign import ccall unsafe "HsUnix.h __hscore_getrlimit" foreign import ccall unsafe "HsUnix.h __hscore_getrlimit"
c_getrlimit :: CInt -> Ptr RLimit -> IO CInt c_getrlimit :: CInt -> Ptr RLimit -> IO CInt
......
...@@ -77,6 +77,7 @@ import Foreign.Ptr ( Ptr, plusPtr ) ...@@ -77,6 +77,7 @@ import Foreign.Ptr ( Ptr, plusPtr )
import Foreign.Storable ( Storable(..) ) import Foreign.Storable ( Storable(..) )
import System.IO.Unsafe ( unsafePerformIO ) import System.IO.Unsafe ( unsafePerformIO )
import System.Posix.Types import System.Posix.Types
import System.Posix.Internals ( CTermios )
#if !HAVE_TCDRAIN #if !HAVE_TCDRAIN
import System.IO.Error ( ioeSetLocation ) import System.IO.Error ( ioeSetLocation )
...@@ -86,7 +87,6 @@ import GHC.IO.Exception ( unsupportedOperation ) ...@@ -86,7 +87,6 @@ import GHC.IO.Exception ( unsupportedOperation )
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Terminal attributes -- Terminal attributes
type CTermios = ()
newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios) newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios)
makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment