Skip to content

Commit 1b798b4

Browse files
committed
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.
1 parent 9208d3a commit 1b798b4

File tree

3 files changed

+27
-19
lines changed

3 files changed

+27
-19
lines changed

System/Posix/IO/Common.hsc

+17-11
Original file line numberDiff line numberDiff line change
@@ -223,25 +223,31 @@ openat_ fdMay str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
223223
c_fd = maybe (#const AT_FDCWD) (\ (Fd fd) -> fd) fdMay
224224
all_flags = creat .|. flags .|. open_mode
225225

226+
-- We have to use Base.o_* instead of raw #const O_*
227+
-- due of the fact target platforms at stage1 could have
228+
-- them overridden.
229+
-- For example GHC JS Backend provides its own constants
230+
-- which should be used at the target of cross compilation
231+
-- into Node.JS environment.
226232
flags =
227-
(if appendFlag then (#const O_APPEND) else 0) .|.
228-
(if exclusiveFlag then (#const O_EXCL) else 0) .|.
229-
(if nocttyFlag then (#const O_NOCTTY) else 0) .|.
230-
(if nonBlockFlag then (#const O_NONBLOCK) else 0) .|.
231-
(if truncateFlag then (#const O_TRUNC) else 0) .|.
233+
(if appendFlag then (Base.o_APPEND) else 0) .|.
234+
(if exclusiveFlag then (Base.o_EXCL) else 0) .|.
235+
(if nocttyFlag then (Base.o_NOCTTY) else 0) .|.
236+
(if nonBlockFlag then (Base.o_NONBLOCK) else 0) .|.
237+
(if truncateFlag then (Base.o_TRUNC) else 0) .|.
232238
(if nofollowFlag then (#const O_NOFOLLOW) else 0) .|.
233239
(if cloexecFlag then (#const O_CLOEXEC) else 0) .|.
234240
(if directoryFlag then (#const O_DIRECTORY) else 0) .|.
235241
(if syncFlag then (#const O_SYNC) else 0)
236242

237243
(creat, mode_w) = case creatFlag of
238244
Nothing -> (0,0)
239-
Just x -> ((#const O_CREAT), x)
245+
Just x -> ((Base.o_CREAT), x)
240246

241247
open_mode = case how of
242-
ReadOnly -> (#const O_RDONLY)
243-
WriteOnly -> (#const O_WRONLY)
244-
ReadWrite -> (#const O_RDWR)
248+
ReadOnly -> (Base.o_RDONLY)
249+
WriteOnly -> (Base.o_WRONLY)
250+
ReadWrite -> (Base.o_RDWR)
245251

246252
foreign import capi unsafe "HsUnix.h openat"
247253
c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt
@@ -315,8 +321,8 @@ data FdOption = AppendOnWrite -- ^O_APPEND
315321

316322
fdOption2Int :: FdOption -> CInt
317323
fdOption2Int CloseOnExec = (#const FD_CLOEXEC)
318-
fdOption2Int AppendOnWrite = (#const O_APPEND)
319-
fdOption2Int NonBlockingRead = (#const O_NONBLOCK)
324+
fdOption2Int AppendOnWrite = (Base.o_APPEND)
325+
fdOption2Int NonBlockingRead = (Base.o_NONBLOCK)
320326
fdOption2Int SynchronousWrites = (#const O_SYNC)
321327

322328
-- | May throw an exception if this is an invalid descriptor.

System/Posix/Semaphore.hsc

+4-3
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import Foreign.ForeignPtr hiding (newForeignPtr)
3030
import Foreign.Concurrent
3131
import Foreign.Ptr
3232
import System.Posix.Types
33+
import qualified System.Posix.Internals as Base
3334
import Control.Concurrent
3435
import Data.Bits
3536
#if !defined(HAVE_SEM_GETVALUE)
@@ -61,11 +62,11 @@ newtype Semaphore = Semaphore (ForeignPtr ())
6162
-- value.
6263
semOpen :: String -> OpenSemFlags -> FileMode -> Int -> IO Semaphore
6364
semOpen name flags mode value =
64-
let cflags = (if semCreate flags then #{const O_CREAT} else 0) .|.
65-
(if semExclusive flags then #{const O_EXCL} else 0)
65+
let cflags = (if semCreate flags then Base.o_CREAT else 0) .|.
66+
(if semExclusive flags then Base.o_EXCL else 0)
6667
semOpen' cname =
6768
do sem <- throwErrnoPathIfNull "semOpen" name $
68-
sem_open cname (toEnum cflags) mode (toEnum value)
69+
sem_open cname (toEnum (fromIntegral cflags)) mode (toEnum value)
6970
fptr <- newForeignPtr sem (finalize sem)
7071
return $ Semaphore fptr
7172
finalize sem = throwErrnoPathIfMinus1_ "semOpen" name $

System/Posix/SharedMem.hsc

+6-5
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ module System.Posix.SharedMem
2626
#include <fcntl.h>
2727

2828
import System.Posix.Types
29+
import qualified System.Posix.Internals as Base
2930
#if defined(HAVE_SHM_OPEN) || defined(HAVE_SHM_UNLINK)
3031
import Foreign.C
3132
#endif
@@ -50,14 +51,14 @@ shmOpen :: String -> ShmOpenFlags -> FileMode -> IO Fd
5051
shmOpen name flags mode =
5152
do cflags0 <- return 0
5253
cflags1 <- return $ cflags0 .|. (if shmReadWrite flags
53-
then #{const O_RDWR}
54-
else #{const O_RDONLY})
55-
cflags2 <- return $ cflags1 .|. (if shmCreate flags then #{const O_CREAT}
54+
then Base.o_RDWR
55+
else Base.o_RDONLY)
56+
cflags2 <- return $ cflags1 .|. (if shmCreate flags then Base.o_CREAT
5657
else 0)
5758
cflags3 <- return $ cflags2 .|. (if shmExclusive flags
58-
then #{const O_EXCL}
59+
then Base.o_EXCL
5960
else 0)
60-
cflags4 <- return $ cflags3 .|. (if shmTrunc flags then #{const O_TRUNC}
61+
cflags4 <- return $ cflags3 .|. (if shmTrunc flags then Base.o_TRUNC
6162
else 0)
6263
withCAString name (shmOpen' cflags4)
6364
where shmOpen' cflags cname =

0 commit comments

Comments
 (0)