From 1b798b40b8a256b276045e38a7c49e280b75a60c Mon Sep 17 00:00:00 2001 From: "Serge S. Gulin" Date: Fri, 25 Apr 2025 19:17:44 +0300 Subject: [PATCH] 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. --- System/Posix/IO/Common.hsc | 28 +++++++++++++++++----------- System/Posix/Semaphore.hsc | 7 ++++--- System/Posix/SharedMem.hsc | 11 ++++++----- 3 files changed, 27 insertions(+), 19 deletions(-) diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc index f8f625b1..63e59c83 100644 --- a/System/Posix/IO/Common.hsc +++ b/System/Posix/IO/Common.hsc @@ -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. diff --git a/System/Posix/Semaphore.hsc b/System/Posix/Semaphore.hsc index c279f8a4..9ac21c88 100644 --- a/System/Posix/Semaphore.hsc +++ b/System/Posix/Semaphore.hsc @@ -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 $ diff --git a/System/Posix/SharedMem.hsc b/System/Posix/SharedMem.hsc index 730994df..28fdd8be 100644 --- a/System/Posix/SharedMem.hsc +++ b/System/Posix/SharedMem.hsc @@ -26,6 +26,7 @@ module System.Posix.SharedMem #include 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 =