Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
+27 −19
Open

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 17 additions & 11 deletions System/Posix/IO/Common.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -223,25 +223,31 @@ 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.
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could you reference a GHC source file which contain overriding logic for JS backend? It would help future readers.

Copy link
Contributor Author

@GulinSS GulinSS Apr 29, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, we have a test which can be referenced for such overridings:

grep -rn testsuite -e 'o_CREAT'

testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs:13590:  o_CREAT :: GHC.Internal.Foreign.C.Types.CInt
testsuite/tests/interface-stability/base-exports.stdout:10544:  o_CREAT :: GHC.Internal.Foreign.C.Types.CInt
testsuite/tests/interface-stability/base-exports.stdout-mingw32:10812:  o_CREAT :: GHC.Internal.Foreign.C.Types.CInt
testsuite/tests/interface-stability/base-exports.stdout-ws-32:10544:  o_CREAT :: GHC.Internal.Foreign.C.Types.CInt

So, files testsuite/tests/interface-stability/base-exports.stdout* can be useful to determine which targets have foreigns (exports? 🤔 ).

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actual overrides are collected at ./libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs. For example o_CREAT:

JS Backend

foreign import javascript unsafe "(() => { return h$base_o_creat; })"    o_CREAT    :: CInt

Other

foreign import ccall unsafe "HsBase.h __hscore_o_creat"  o_CREAT  :: CInt

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Probably need create a [Note] there at sources?

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) .|.
(if syncFlag then (#const O_SYNC) else 0)

(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
Expand Down Expand Up @@ -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)
Copy link
Contributor

@Bodigrim Bodigrim Apr 28, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is there a reason for the inconsistency, beyond GHC exporting incomplete set? Could you please raise an issue on GHC side to provide a complete set in future? (We can leave unix source code inconsistent for the time being, but I'd like this to be rectified in future)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Created


-- | May throw an exception if this is an invalid descriptor.
Expand Down
7 changes: 4 additions & 3 deletions System/Posix/Semaphore.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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 $
Expand Down
11 changes: 6 additions & 5 deletions System/Posix/SharedMem.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand Down
Loading