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

Replace `__hscore_mk{dtemp,stemp,stemps}` wrappers with CApiFFI

parent 36460403
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE CApiFFI #-}
#if __GLASGOW_HASKELL__ >= 709 #if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-} {-# LANGUAGE Safe #-}
#else #else
...@@ -33,7 +34,7 @@ import System.Posix.IO ...@@ -33,7 +34,7 @@ import System.Posix.IO
import System.Posix.Types import System.Posix.Types
import System.Posix.Internals (withFilePath, peekFilePath) import System.Posix.Internals (withFilePath, peekFilePath)
foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" foreign import capi unsafe "HsUnix.h mkstemp"
c_mkstemp :: CString -> IO CInt c_mkstemp :: CString -> IO CInt
-- | Make a unique filename and open it for reading\/writing. The returned -- | Make a unique filename and open it for reading\/writing. The returned
...@@ -53,7 +54,7 @@ mkstemp template' = do ...@@ -53,7 +54,7 @@ mkstemp template' = do
return (name, h) return (name, h)
#if HAVE_MKSTEMPS #if HAVE_MKSTEMPS
foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" foreign import capi unsafe "HsUnix.h mkstemps"
c_mkstemps :: CString -> CInt -> IO CInt c_mkstemps :: CString -> CInt -> IO CInt
#endif #endif
...@@ -81,7 +82,7 @@ mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform" ...@@ -81,7 +82,7 @@ mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform"
#endif #endif
#if HAVE_MKDTEMP #if HAVE_MKDTEMP
foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" foreign import capi unsafe "HsUnix.h mkdtemp"
c_mkdtemp :: CString -> IO CString c_mkdtemp :: CString -> IO CString
#endif #endif
......
{-# LANGUAGE CApiFFI #-}
#if __GLASGOW_HASKELL__ >= 709 #if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-} {-# LANGUAGE Safe #-}
#else #else
...@@ -38,7 +39,7 @@ import System.Posix.Directory (createDirectory) ...@@ -38,7 +39,7 @@ import System.Posix.Directory (createDirectory)
import System.Posix.IO import System.Posix.IO
import System.Posix.Types import System.Posix.Types
foreign import ccall unsafe "HsUnix.h __hscore_mkstemp" foreign import capi unsafe "HsUnix.h mkstemp"
c_mkstemp :: CString -> IO CInt c_mkstemp :: CString -> IO CInt
-- | Make a unique filename and open it for reading\/writing. The returned -- | Make a unique filename and open it for reading\/writing. The returned
...@@ -58,7 +59,7 @@ mkstemp template' = do ...@@ -58,7 +59,7 @@ mkstemp template' = do
return (name, h) return (name, h)
#if HAVE_MKSTEMPS #if HAVE_MKSTEMPS
foreign import ccall unsafe "HsUnix.h __hscore_mkstemps" foreign import capi unsafe "HsUnix.h mkstemps"
c_mkstemps :: CString -> CInt -> IO CInt c_mkstemps :: CString -> CInt -> IO CInt
#endif #endif
...@@ -82,7 +83,7 @@ mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform" ...@@ -82,7 +83,7 @@ mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform"
#endif #endif
#if HAVE_MKDTEMP #if HAVE_MKDTEMP
foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp" foreign import capi unsafe "HsUnix.h mkdtemp"
c_mkdtemp :: CString -> IO CString c_mkdtemp :: CString -> IO CString
#endif #endif
......
...@@ -65,22 +65,6 @@ int __hsunix_push_module(int fd, const char *module) ...@@ -65,22 +65,6 @@ int __hsunix_push_module(int fd, const char *module)
#endif #endif
} }
int __hscore_mkstemp(char *filetemplate) {
return (mkstemp(filetemplate));
}
#if HAVE_MKSTEMPS
int __hscore_mkstemps(char *filetemplate, int suffixlen) {
return (mkstemps(filetemplate, suffixlen));
}
#endif
#if HAVE_MKDTEMP
char *__hscore_mkdtemp(char *filetemplate) {
return (mkdtemp(filetemplate));
}
#endif
#ifdef HAVE_UNSETENV #ifdef HAVE_UNSETENV
int __hsunix_unsetenv(const char *name) int __hsunix_unsetenv(const char *name)
{ {
......
...@@ -134,16 +134,6 @@ int __hsunix_unlockpt(int fd); ...@@ -134,16 +134,6 @@ int __hsunix_unlockpt(int fd);
// push a SVR4 STREAMS module; do nothing if STREAMS not available // push a SVR4 STREAMS module; do nothing if STREAMS not available
int __hsunix_push_module(int fd, const char *module); int __hsunix_push_module(int fd, const char *module);
int __hscore_mkstemp(char *filetemplate);
#if HAVE_MKSTEMPS
int __hscore_mkstemps(char *filetemplate, int suffixlen);
#endif
#if HAVE_MKDTEMP
char *__hscore_mkdtemp(char *filetemplate);
#endif
int __hsunix_unsetenv(const char *name); int __hsunix_unsetenv(const char *name);
/* A size that will contain many path names, but not necessarily all /* A size that will contain many path names, but not necessarily all
......
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