Skip to content
Snippets Groups Projects
Commit 096206d2 authored by Serge S. Gulin's avatar Serge S. Gulin :construction_worker: Committed by Julian Ospald
Browse files

Use `Base.o_*` instead of raw `{#const O_*}`

`stage1` cross compilers could use different values instead of
system-defined. GHC JS Backend change these constants to be compatible
with Node.js environment.
parent 9208d3a5
No related branches found
No related tags found
No related merge requests found
......@@ -223,12 +223,18 @@ openat_ fdMay str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
c_fd = maybe (#const AT_FDCWD) (\ (Fd fd) -> fd) fdMay
all_flags = creat .|. flags .|. open_mode
-- We have to use Base.o_* instead of raw #const O_*
-- due of the fact target platforms at stage1 could have
-- them overridden.
-- For example GHC JS Backend provides its own constants
-- which should be used at the target of cross compilation
-- into Node.JS environment.
flags =
(if appendFlag then (#const O_APPEND) else 0) .|.
(if exclusiveFlag then (#const O_EXCL) else 0) .|.
(if nocttyFlag then (#const O_NOCTTY) else 0) .|.
(if nonBlockFlag then (#const O_NONBLOCK) else 0) .|.
(if truncateFlag then (#const O_TRUNC) else 0) .|.
(if appendFlag then (Base.o_APPEND) else 0) .|.
(if exclusiveFlag then (Base.o_EXCL) else 0) .|.
(if nocttyFlag then (Base.o_NOCTTY) else 0) .|.
(if nonBlockFlag then (Base.o_NONBLOCK) else 0) .|.
(if truncateFlag then (Base.o_TRUNC) else 0) .|.
(if nofollowFlag then (#const O_NOFOLLOW) else 0) .|.
(if cloexecFlag then (#const O_CLOEXEC) else 0) .|.
(if directoryFlag then (#const O_DIRECTORY) else 0) .|.
......@@ -236,12 +242,12 @@ openat_ fdMay str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
(creat, mode_w) = case creatFlag of
Nothing -> (0,0)
Just x -> ((#const O_CREAT), x)
Just x -> ((Base.o_CREAT), x)
open_mode = case how of
ReadOnly -> (#const O_RDONLY)
WriteOnly -> (#const O_WRONLY)
ReadWrite -> (#const O_RDWR)
ReadOnly -> (Base.o_RDONLY)
WriteOnly -> (Base.o_WRONLY)
ReadWrite -> (Base.o_RDWR)
foreign import capi unsafe "HsUnix.h openat"
c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt
......@@ -315,8 +321,8 @@ data FdOption = AppendOnWrite -- ^O_APPEND
fdOption2Int :: FdOption -> CInt
fdOption2Int CloseOnExec = (#const FD_CLOEXEC)
fdOption2Int AppendOnWrite = (#const O_APPEND)
fdOption2Int NonBlockingRead = (#const O_NONBLOCK)
fdOption2Int AppendOnWrite = (Base.o_APPEND)
fdOption2Int NonBlockingRead = (Base.o_NONBLOCK)
fdOption2Int SynchronousWrites = (#const O_SYNC)
-- | May throw an exception if this is an invalid descriptor.
......
......@@ -30,6 +30,7 @@ import Foreign.ForeignPtr hiding (newForeignPtr)
import Foreign.Concurrent
import Foreign.Ptr
import System.Posix.Types
import qualified System.Posix.Internals as Base
import Control.Concurrent
import Data.Bits
#if !defined(HAVE_SEM_GETVALUE)
......@@ -61,11 +62,11 @@ newtype Semaphore = Semaphore (ForeignPtr ())
-- value.
semOpen :: String -> OpenSemFlags -> FileMode -> Int -> IO Semaphore
semOpen name flags mode value =
let cflags = (if semCreate flags then #{const O_CREAT} else 0) .|.
(if semExclusive flags then #{const O_EXCL} else 0)
let cflags = (if semCreate flags then Base.o_CREAT else 0) .|.
(if semExclusive flags then Base.o_EXCL else 0)
semOpen' cname =
do sem <- throwErrnoPathIfNull "semOpen" name $
sem_open cname (toEnum cflags) mode (toEnum value)
sem_open cname (toEnum (fromIntegral cflags)) mode (toEnum value)
fptr <- newForeignPtr sem (finalize sem)
return $ Semaphore fptr
finalize sem = throwErrnoPathIfMinus1_ "semOpen" name $
......
......@@ -26,6 +26,7 @@ module System.Posix.SharedMem
#include <fcntl.h>
import System.Posix.Types
import qualified System.Posix.Internals as Base
#if defined(HAVE_SHM_OPEN) || defined(HAVE_SHM_UNLINK)
import Foreign.C
#endif
......@@ -50,14 +51,14 @@ shmOpen :: String -> ShmOpenFlags -> FileMode -> IO Fd
shmOpen name flags mode =
do cflags0 <- return 0
cflags1 <- return $ cflags0 .|. (if shmReadWrite flags
then #{const O_RDWR}
else #{const O_RDONLY})
cflags2 <- return $ cflags1 .|. (if shmCreate flags then #{const O_CREAT}
then Base.o_RDWR
else Base.o_RDONLY)
cflags2 <- return $ cflags1 .|. (if shmCreate flags then Base.o_CREAT
else 0)
cflags3 <- return $ cflags2 .|. (if shmExclusive flags
then #{const O_EXCL}
then Base.o_EXCL
else 0)
cflags4 <- return $ cflags3 .|. (if shmTrunc flags then #{const O_TRUNC}
cflags4 <- return $ cflags3 .|. (if shmTrunc flags then Base.o_TRUNC
else 0)
withCAString name (shmOpen' cflags4)
where shmOpen' cflags cname =
......
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